[RaggiTech]

كاتب الموضوع : AhmedEssawy

بداية قم بتعريف هذه المتغيرات والتي سيتم الاستفادة منها لاحقاً في عملية الأخطاء أو التواريخ غير الحقيقة ، وفي الواقع يمكن الاستغناء عن هذا الموضوع بسهولة ولكني ناقل للكود :

كود :

Const ERR_INVALID_DATE = 20000
Const ERR_INVALID_DATE_MSG = "Date Required"

أما الدالة التي تقوم بالحساب :

كود :

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

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