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

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