Microsoft 365 VBA : fonction qui calcule une durée entre 2 dates en années, mois et jours

Sub Macro2()
    [A1].Formula = _
        "=DATEDIF(F3,TODAY(),""y"")&"" ans, ""&DATEDIF(F3,TODAY(),""ym"")&"" mois et ""&DATEDIF(F3,TODAY(),""md"")&"" jours"""
    [A1] = [A1].Value
End Sub

Function QuelAge(d1 As Date, Optional d2, Optional Précision) As String
Dim a&, m&, s&, j&
'précision: détermine le niveau de détail de l'age: j, s, m, a
    If IsMissing(Précision) Then Précision = "j"
    If IsMissing(d2) Then d2 = Now()
    If d1 > d2 Then QuelAge = "La 2ème date doit nécessairement être plus grande que la 1ère !"

    If (d1 > 60) * (d1 <= d2) Then
        Do While DateSerial(Year(d1) + a + 1, Month(d1), Day(d1)) <= d2: a = a + 1: Loop
        If Précision = "a" Then
            QuelAge = a & " an" & IIf(a > 1, "s", "")
            Exit Function
        End If
        
        Do While DateSerial(Year(d1) + a, Month(d1) + m + 1, Day(d1)) <= d2: m = m + 1: Loop
        If Précision = "m" Then
            QuelAge = IIf(a, a & " an" & IIf(a > 1, "s", "") & " ", "") & IIf(m, m & " mois ", "")
            Exit Function
        End If
        
        Do While DateSerial(Year(d1) + a, Month(d1) + m, Day(d1) + (s + 1) * 7) <= d2: s = s + 1: Loop
        If Précision = "s" Then
            QuelAge = IIf(a, a & " an" & IIf(a > 1, "s", "") & " ", "") & IIf(m, m & " mois ", "") & IIf(s, s & " semaine" & IIf(s > 1, "s", "") & " ", "")
            Exit Function
        End If
        
        Do While DateSerial(Year(d1) + a, Month(d1) + m, Day(d1) + s * 7 + j + 1) <= d2: j = j + 1: Loop
        QuelAge = 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

Sub Essai()
DL = Cells(Cells.Rows.Count, "A").End(xlUp).Row ' Adapter avec la plage de dates
With Range("B2:B" & DL)                  ' Adapter avec la plage résultats
.Formula = _
        "=DATEDIF(A2,TODAY(),""y"")&"" ans, ""&DATEDIF(A2,TODAY(),""ym"")&"" mois et ""&DATEDIF(A2,TODAY(),""md"")&"" jours"""
        ' Adapter le A2 avec la première cellule de la plage dates.
.Value = .Value ' A supprimer si on veut garder les formules, à conserver si on veut avoir que les valeurs.
End With
End Sub

Function DureeEntreDates(d1 As Date, d2 As Date) As String
    Dim years As Integer, months As Integer, days As Integer
    Dim tmp As Date
    If d1 > d2 Then: tmp = d1: d1 = d2: d2 = tmp ' S'assurer que d1 est antérieure à d2
    years = Year(d2) - Year(d1): months = Month(d2) - Month(d1): days = Day(d2) - Day(d1)
    If days < 0 Then: months = months - 1: days = days + Day(DateSerial(Year(d2), Month(d2), 0))
    If months < 0 Then: years = years - 1: months = months + 12
    DureeEntreDates = years & " ans, " & months & " mois, " & days & " jours"
End Function