Zjištění věku osoby

Const ERR_INVALID_DATE = 20000
Const ERR_INVALID_DATE_MSG = "Požadováno datum"
'BirthDate: datum narození osoby, buď jako datum nebo string
'RelativeTo (Optional): vztažné datum. Nevyplněné znamená aktuální datum 

Public Function Age(BirthDate As Variant,Optional RelativeTo As Variant) As Integer

   Dim dBDate As Date, dRelDate As Date
   Dim bSubtractOne As Boolean
   Dim iAns As Integer

   If IsMissing(RelativeTo) Then
      RelativeTo = Now
   ElseIf Not IsDate(RelativeTo) Then
      err.Raise ERR_INVALID_DATE, , ERR_INVALID_DATE_MSG
   End If

   If Not IsDate(BirthDate) Then 
      err.Raise ERR_INVALID_DATE, ,ERR_INVALID_DATE_MSG
   End If

   dBDate = CDate(BirthDate)
   dRelDate = CDate(RelativeTo)
   iAns = Year(dRelDate) - Year(dBDate)

   If Month(dBDate) <> Month(dRelDate) Then
      bSubtractOne = Month(dBDate) > Month(dRelDate)
   Else
      bSubtractOne = Day(dBDate) > Day(dRelDate)
   End If

   If bSubtractOne Then iAns = iAns - 1
   Age = iAns

End Function

Zpět