VBA, MS Access MS Access в примерах

Дата - Расчёт кол-ва дней до Дня Рождения (Сотрудника например) по Дате Рождения

Public Function ToBirthDayDays(vBirthDay As Variant) As Integer
'es 19.04.2018
'Расчёт кол-ва дней до Дня Рождения (Сотрудника например) по Дате Рождения
' ... на текущую  дату, при ошибках возвращает -1 (минус один)
'--------------------------------------------------------------------------
'Примеры эксплуотации:
'   ?ToBirthDayDays(#30/04/1988#)
'   =ToBirthDayDays([ДатаРождения])
'--------------------------------------------------------------------------
Dim iYear As Integer
Dim iMonth As Integer
Dim iDay As Integer
Dim dBD_Date As Date 'дата дня рождения в текущем (или следуещем )году
On Error GoTo ToBirthDayDays_Err
    iYear = Year(Date)
    iMonth = Month(vBirthDay)
    iDay = Day(vBirthDay)
    
    dBD_Date = DateSerial(iYear, iMonth, iDay) 'Дата ДР в этом году

'Проверка был-ли уже ДР в этом году
    If dBD_Date < Date Then 'В этом году ДР уже был ...
        'Расчитывем в следующем году ...
        dBD_Date = DateSerial(iYear + 1, iMonth, iDay)
    End If

'Получаем кол-во дней до следующего ДР
    ToBirthDayDays = DateDiff("d", Date, dBD_Date)

ToBirthDayDays_Bye:
    Exit Function

ToBirthDayDays_Err:
    ToBirthDayDays = -1
    Err.Clear
    Resume ToBirthDayDays_Bye
End Function
Назад ToTop
L.E. 19.04.2018
Рейтинг@Mail.ru