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