تفضل
' من روائع ابي هادي مع بعض تصرف
'--------------------------------------
Const YearAvg = 365.25
Dim vDays As Long
'----------------
Dim vyy As Integer
Dim vmm As Integer
Dim vdd As Integer
Dim alldays As Integer, halfdays As Integer
alldays = DateDiff("d", date1, date2)
halfdays = alldays \ 2
If Me.Frame1 = 1 Then
vDays = alldays
Else
vDays = halfdays
End If
vyy = Fix(vDays / 365)
If Fix(vyy * YearAvg) > vDays Then
vyy = vyy - 1
End If
'-------------------------------
vDays = vDays - Fix(vyy * YearAvg)
'-------------------------------
vmm = Fix(vDays / 29.5)
If IIf(vmm > 2, CLng((vmm - 2) * 30.6) + 59, CLng(vmm * 30.6) + Int(vmm > 1) * 2) > vDays Then
vmm = vmm - 1
End If
'-------------------------------
vdd = vDays - IIf(vmm > 2, CLng((vmm - 2) * 30.6) + 59, CLng(vmm * 30.6) + Int(vmm > 1) * 2)
Me.m_d = vdd
Me.m_m = vmm
Me.m_y = vyy
test13.rar