Function AgeG(DateDebut, DateFin)
Dim dD As Double, dF As Double
If DateDebut.Text Like "*#/##/##*" Then
dD = DateValue(DateDebut.Text)
If DateFin.Text Like "*#/##/##*" Then
dF = DateValue(DateFin.Text)
AgeG = Int((dF - dD) / 365.25)
Else
AgeG = " ? format jj/mm/aaaa"
End If
Else
AgeG = " ? format jj/mm/aaaa"
End If
End Function
Sub tests()
'dernier jour de fevrier
bisextile = Day(DateSerial(1574, 3, 0)) = 29
MsgBox "fevrier 1574 " & bisextile
bisextile = Day(DateSerial(1600, 3, 0)) = 29
MsgBox "fevrier 1600 " & bisextile
End Sub
Sub test()
date1 = CDate("01/01/2020")
date2 = CDate("10/03/2020")
MsgBox DateDiffAMJ4$(date1, date2)
date1 = CDate("01/01/2021")
date2 = CDate("10/03/2021")
MsgBox DateDiffAMJ4$(date1, date2)
date1 = CDate("10/02/2020")
date2 = CDate("09/03/2020")
MsgBox DateDiffAMJ4$(date1, date2)
date1 = CDate("10/02/2021")
date2 = CDate("09/03/2021")
MsgBox DateDiffAMJ4$(date1, date2)
date1 = CDate("10/02/2020")
date2 = CDate("10/03/2020")
MsgBox DateDiffAMJ4$(date1, date2)
date1 = CDate("10/02/2021")
date2 = CDate("10/03/2021")
MsgBox DateDiffAMJ4$(date1, date2)
date1 = CDate("10/02/2021")
date2 = CDate("17/03/2021")
MsgBox DateDiffAMJ4$(date1, date2)
date1 = CDate("10/02/1574")
date2 = CDate("17/03/1574")
MsgBox DateDiffAMJ4$(date1, date2)
date1 = CDate("10/02/1574")
date2 = CDate("17/03/1633")
MsgBox DateDiffAMJ4$(date1, date2)
End Sub
Function DateDiffAMJ4$(ByVal dat1 As Date, ByVal dat2 As Date)
Dim A$, M$, J$, Dtemp$, et$, yeardécalée&, Y
If dat1 > dat2 Then Dtemp = dat2: dat2 = dat1: dat1 = Dtemp
If Year(date1) < 1904 Then If Year(date1) Mod 4 <> 0 Or Year(date1) Mod 400 <> 0 Then Y = 2020 Else Y = 1904
If Year(dat1) < Y Or Year(dat2) < Y Then
'on decale la date la plus ancienne (Dat1)à l'année 1904
yeardécalée = Abs((Year(dat1) - Y))
dat1 = DateSerial(Year(dat1) + yeardécalée, Month(dat1), Day(dat1))
dat2 = DateSerial(Year(dat2) + yeardécalée, Month(dat2), Day(dat2))
End If
A = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""y"")")
M = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""ym"")")
J = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""md"")")
A = IIf(A = 0, "", IIf(A = 1, A & " an", A & " ans"))
M = IIf(M = 0, "", IIf(M = 1, M & " mois", M & " mois"))
J = IIf(J = 0, "", IIf(J = 1, "1 jour", J & " jours"))
et = IIf(Val(A) > 0 Or Val(M) > 0, IIf(Val(J) > 0, " et ", " "), "")
DateDiffAMJ4 = Application.Trim(A & " " & M & " " & et & J)
End Function
'**************************************
'fonction DateDiffAMJ V°4
'auteur:patricktoulon sur Exceldownloads
'date de mise en jour V°4:04/07/2021
'licence :libre si commentaire
'*************************************
Function DateDiffAMJ4$(ByVal dat1 As Date, ByVal dat2 As Date)
Dim A$, M$, J$, Dtemp$, et$, yeardécalée&, y
If dat1 > dat2 Then Dtemp = dat2: dat2 = dat1: dat1 = Dtemp
If Year(dat1) < 1904 Then If Year(dat1) Mod 4 = 0 Or Year(dat1) Mod 400 = 0 Then y = 2020 Else y = 1904
If Year(dat1) < y Then
'on decale la date la plus ancienne (Dat1)à l'année 1904
yeardécalée = Abs((Year(dat1) - y))
dat1 = DateSerial(Year(dat1) + yeardécalée, Month(dat1), Day(dat1))
dat2 = DateSerial(Year(dat2) + yeardécalée, Month(dat2), Day(dat2))
End If
A = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""y"")")
M = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""ym"")")
J = Evaluate("=DATEDIF(" & CLng(dat1) & "," & CLng(dat2) & ",""md"")")
A = IIf(A = 0, "", IIf(A = 1, A & " an", A & " ans"))
M = IIf(M = 0, "", IIf(M = 1, M & " mois", M & " mois"))
J = IIf(J = 0, "", IIf(J = 1, "1 jour", J & " jours"))
et = IIf(Val(A) > 0 Or Val(M) > 0, IIf(Val(J) > 0, " et ", " "), "")
DateDiffAMJ4 = Application.Trim(A & " " & M & " " & et & J)
End Function