Function diffDate(d1 As Date, d2 As Date) As String
Dim d As Date, a&, m&, s&, j&
d = WorksheetFunction.Min(d1, d2)
If (d > 60) Then
If (d <> d1) * (d1 <> d2) Then diffDate = "moins " 'signe
d2 = WorksheetFunction.Max(d1, d2): d1 = d
Do While DateSerial(Year(d1) + a + 1, Month(d1), Day(d1)) <= d2: a = a + 1: Loop 'Années
Do While DateSerial(Year(d1) + a, Month(d1) + m + 1, Day(d1)) <= d2: m = m + 1: Loop 'Mois
Do While DateSerial(Year(d1) + a, Month(d1) + m, Day(d1) + (s + 1) * 7) <= d2: s = s + 1: Loop 'Semaines
Do While DateSerial(Year(d1) + a, Month(d1) + m, Day(d1) + s * 7 + j + 1) <= d2: j = j + 1: Loop 'Jours
diffDate = diffDate & 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", ""), "") 'Affichage
End If
End Function