TopPicLogo TopPicText

Возраст на конкретную или текущую дату

Public Function esAge(bdDate As Variant, Optional forDate As Variant = Null) As Integer
'es 06.12.2012
'Возвращает возраст на текущую дату (или на конкретную дату)
'   при ошибке или пустом аргументе bdDate возвращает -1 (МИНУС ОДИН)
'Аргументы:
'   bdDate    -  Дата Рождения
'   forDate   -  Дата на которую расчитать (по умолчанию = сегодня)
'--------------------------------------------------------------------------
On Error GoTo esAgeErr
'Проверяем аргументы
    If IsNull(forDate) Then forDate = Date

'Разница в годах между датой рождения и датой на которую
    esAge = DateDiff("yyyy", bdDate, forDate)

'Вычитается один год, если в этом году дня рождения еще не было
    If DateSerial(Year(forDate), Month(bdDate), Day(bdDate)) > forDate Then
        esAge = esAge - 1
    End If
esAgeBye:
    Exit Function
esAgeErr:
    Err.Clear
    esAge = -1
    Resume esAgeBye
End Function

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