VBA, MS Access MS Access в примерах

Возраст на текущую дату (полных лет и месяцев)

Из примера от MS - "Вычисление возраста.accdb"


'*************************************************************
' FUNCTION NAME: Age()
'
' PURPOSE:
'    Calculates age in years from a specified date to today's date.
'
' INPUT PARAMETERS:
'    varBirthDate:  a birth date.
'
' RETURN
'    Age in years.
'
'*************************************************************
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 NAME: AgeMonths()
'
' PURPOSE:
'  Compliments the Age() function by calculating the number of months
'  that have expired since the last month supplied by the specified date.
'  If the specified date is a birthday, the function returns the number of
'    months since the last birthday.
'
' INPUT PARAMETERS:
'    varBirthDate:  a birth date.
'
' RETURN
'    Months since the last birthday.
'*************************************************************
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
                 


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