Function diffDateP(d1 As Date, d2 As Date, Optional An As Boolean = True, Optional Mo As Boolean = True, Optional Se As Boolean = True, Optional P As Boolean) 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 diffDateP = "moins " 'signe '
d2 = WorksheetFunction.Max(d1, d2): d1 = d - P * ((diffDateP = "") Or (d = d2))
If An Then Do While DateSerial(Year(d1) + a + 1, Month(d1), Day(d1)) <= d2: a = a + 1: Loop 'Années '
If Mo Then Do While DateSerial(Year(d1) + a, Month(d1) + m + 1, Day(d1)) <= d2: m = m + 1: Loop 'Mois '
If Se Then 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 '
diffDateP = diffDateP & 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