MyTetra Share
Делитесь знаниями!
Дата - Расчёт кол-ва дней до Дня Рождения (Сотрудника например) по Дате Рождения
19.07.2018
19:39
Раздел: VBA - Access - msa.polarcom.ru - 14 Преобразование Чисел и Дат


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

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



Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования