|
|
Возраст на текущую дату (полных лет и месяцев)
Из примера от MS - "Вычисление возраста.accdb"
Function Age(varBirthDate As Variant) As Integer
Dim varAge As Variant
If IsNull(varBirthDate) Then Age = 0: Exit Function
varAge = DateDiff("yyyy", varBirthDate, Now)
If Date < DateSerial(Year(Now), Month(varBirthDate), _
Day(varBirthDate)) Then
varAge = varAge - 1
End If
Age = CInt(varAge)
End Function
Function AgeMonths(ByVal varBirthDate As Variant) As Integer
If IsNull(varBirthDate) Then AgeMonths = 0: Exit Function
Dim tAge As Double
tAge = (DateDiff("m", varBirthDate, Now))
If (DatePart("d", varBirthDate) > DatePart("d", Now)) Then
tAge = tAge - 1
End If
If tAge < 0 Then
tAge = tAge + 1
End If
AgeMonths = CInt(tAge Mod 12)
End Function
|
|