|
|
Возраст на конкретную или текущую дату с точностью до месяца и дня (текстом)
Public Function AgeByBirthDayStr(bdDate As Variant, Optional forDate As Variant = Null) As String
Dim dLastBDay As Date
Dim iYears%, iMonthes%, iDays%, i%
On Error GoTo AgeByBirthDayErr
If IsNull(forDate) Then forDate = Date
iYears = DateDiff("yyyy", bdDate, forDate)
dLastBDay = DateSerial(Year(forDate), Month(bdDate), Day(bdDate))
If dLastBDay > forDate Then
iYears = iYears - 1
End If
i = Year(bdDate) + iYears
dLastBDay = DateSerial(i, Month(bdDate), Day(bdDate))
iMonthes = DateDiff("m", dLastBDay, forDate)
If Day(bdDate) > Day(forDate) Then
iMonthes = iMonthes - 1
End If
dLastBDay = DateSerial(i, Month(bdDate) + iMonthes, Day(bdDate))
iDays = DateDiff("d", dLastBDay, forDate)
AgeByBirthDayStr = "Лет: " & iYears
AgeByBirthDayStr = AgeByBirthDayStr & " Мес: " & iMonthes
AgeByBirthDayStr = AgeByBirthDayStr & " Дней: " & iDays
AgeByBirthDayBye:
Exit Function
AgeByBirthDayErr:
AgeByBirthDayStr = "Err!:" & Err.Number
Err.Clear
Resume AgeByBirthDayBye
End Function
|
|