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

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

Public Function ToBirthDayDays(vBirthDay As Variant, Optional iMinLimit% = 365) As Integer
'es 19.04.2018 LE  05.05.2023- v002
'Расчёт кол-ва дней до Дня Рождения (Сотрудника например) по Дате Рождения
' ... на текущую  дату, при ошибках возвращает -1 (минус один)
'--------------------------------------------------------------------------
'Аргумент : iMinLimit = ограничитель показа (за сколько дней до ДР показывать)
'--------------------------------------------------------------------------
'Примеры эксплуатации:
'   ?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

'Получаем кол-во дней до следующего ДР
    iDay = DateDiff("d", Date, dBD_Date)
    If iDay <= iMinLimit Then
        ToBirthDayDays = iDay
    End If
    
ToBirthDayDays_Bye:
    Exit Function

ToBirthDayDays_Err:
    ToBirthDayDays = -1
    Err.Clear
    Resume ToBirthDayDays_Bye
End Function

Назад ToTop
L.E. 05.05.2023
Рейтинг@Mail.ru