страничка tripsin'а

Главная | Статьи | Заметки | Файлы| Ссылки | я

Напоминальщик дней рождений

У меня на работе кадровичку главный врач постоянно тюкал, что она ничего не делает, и не может даже вовремя вспомнить, что у кого-то день рождения. На помощь ей пришел конечно я, и сделал этот крохотный скрипт.

Он ничего такого особенного не делает. Просто открывает экселевскую таблицу, со всеми работниками нашего мощного санатория. В ней кроме прочего есть столбец с днями рождения. Такая табличка наверняка есть у каждого кадровика. Потом в цикле проверяется все ячейки с датами на соответствие текущей и завтрашней дате. Это чтобы у народа было время подготовиться (подарок хотя-бы купить). Тут одна хитрость. "Специальная" ячейка за нумером xlCellTypeLastCell = 11 обозначает последнюю (самую нижнюю) заполненную ячейку на листе. Мы узнаем в какой она строке (ObjXL.Cells.SpecialCells(11).Row) и крутим цикл именно до этой строки. Таким макаром нам не надо знать сколько записей в таблице. Их можно спокойно удалять и добавлять.

Если находится совпадение с сегодняшней или завтрашней датой, то имя этого работяги мы добавляем в сообщение с позравлением. Все! А тут сам скрипт:

'***********************************************************
'          Напоминальщик Дней Рождений (версия 2.0)        *
'                                                          *
'           Автор скрипта:  tripsin                        *
'                 с.п. "Талица", 2006 г.                   *
'***********************************************************
'  Использует таблицу Excel - BirthDays.xls                *
'  При добавлении новых данных в таблицу                   *
'  форматировать ячейку даты рождения в виде "ДД.ММ.ГГ"    *
'***********************************************************
'
Set objXL = WScript.CreateObject("Excel.Application")
objXL.Visible = FALSE
objXL.WorkBooks.Open("C:\BirthDayReminder\BirthDays.xls") 
objXL.Sheets("Лист1").Activate

today = "-------------------- Сегодня ! --------------------" & vbCRLF
oldtoday = today 
tomorrow = "-------------------- Завтра ! --------------------" & vbCRLF
oldtomorrow = tomorrow

For i = 1 to objXL.Cells.SpecialCells(11).Row  'xlCellTypeLastCell = 11
 Set CurCell = objXL.Cells(i,5)
 If CurCell.NumberFormat = "ДД.ММ.ГГ" or _
    CurCell.NumberFormat = "m/d/yy" or _
    CurCell.NumberFormat = "m/d/yyyy"  then
   If Day(CurCell) = Day(Date) and Month(CurCell) = Month(Date) then
      today = today & objXL.Cells(i,3)& " (" & objXL.Cells(i,4) & ") - " & _
              (Year(Date) - Year(CurCell)) & vbCRLF
   End If
   If Day(CurCell) = Day(Date + 1) and Month(CurCell) = Month(Date + 1) then
      tomorrow = tomorrow & objXL.Cells(i,3)& " (" & objXL.Cells(i,4) & ") - " & _
              (Year(Date) - Year(CurCell)) & vbCRLF
   End If
 End if
Next

str = ""  'today <> oldtoday or tomorrow <> oldtomorrow today & vbCRLF & vbCRLF & tomorrow
If today <> oldtoday then str = vbCRLF & today  & vbCRLF & vbCRLF
If tomorrow <> oldtomorrow then str = str & tomorrow 
If str <> "" then 
  Call MsgBox (str, vbOkOnly + vbExclamation, "День рождения !!!")
End If

objXL.Quit
Скачать (16,5кб)
Hosted by uCoz