+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : الأقسام التعليمية - المنتدى القديم (http://vb4arb.com/vb/forumdisplay.php?fid=90)
+--- قسم : مكتبة أكواد المنتدى (http://vb4arb.com/vb/forumdisplay.php?fid=111)
+---- قسم : مكتبة أكواد الفيجوال بيسك 6 (http://vb4arb.com/vb/forumdisplay.php?fid=116)
+---- الموضوع : حساب عمر الشخص اعتماداً على تاريخ الميلاد (/showthread.php?tid=5853)
حساب عمر الشخص اعتماداً على تاريخ الميلاد - RaggiTech - 17-10-12
كاتب الموضوع : 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