Public Function CalculAge(d1 As Date, d2 As Date) As String 'fonction qui retourne l'age en yy/mm/dd (fonction récupérée sur le net, pas vérifiée (https://www.developpez.net/forums/d655595/logiciels/microsoft-office/excel/macros-vba-excel/formule-calculer-age-textbox/)
CalculAge = "une date est manquante"
If Not IsDate(d1) Or Not IsDate(d2) Then Exit Function
CalculAge = "La 2ème date doit nécessairement être plus grande que la 1ère !"
If DateValue(d1) > DateValue(d2) Or Not IsDate(d2) Then Exit Function
Dim toto As String, A As Integer, m As Integer, j As Integer
toto = DateValue(DateSerial(Year(d2) - Year(d1), Month(d2) - Month(d1), Day(d2) - Day(d1)))
A = Val(Format(toto, "yy"))
m = Val(Format(toto, "mm"))
j = Val(Format(toto, "dd"))
CalculAge = Str(A) & " an" & IIf(A > 1, "s, ", ", ") & Str(m) & " mois et " & Str(j) & " jour" & IIf(j > 1, "s", "")
End Function
Function Age(d1 As Date, Optional d2) As String
If IsMissing(d2) Then d2 = Now()
Dim A&, m&, s&, j&
If (d1 > 60) * (d1 <= d2) Then
Do While DateSerial(Year(d1) + A + 1, Month(d1), Day(d1)) < d2: A = A + 1: Loop
Do While DateSerial(Year(d1) + A, Month(d1) + m + 1, Day(d1)) < d2: m = m + 1: Loop
Do While DateSerial(Year(d1) + A, Month(d1) + m, Day(d1) + (s + 1) * 7) < d2: s = s + 1: Loop
Do While DateSerial(Year(d1) + A, Month(d1) + m, Day(d1) + s * 7 + j + 1) < d2: j = j + 1: Loop
Age = IIf(A, A & " an" & IIf(A > 1, "s", "") & " ", "") & IIf(m, m & " mois ", "") & IIf(s, s & " semaine" & IIf(s > 1, "s", "") & " ", "") & IIf(j Or (A + m + j = 0), j & " jour" & IIf(j > 1, "s", ""), "")
End If
End Function