Private Function Calc_Diff (ByVal maDate1 As Date, _
ByVal maDate2 As Date) As String
' Renvoie une chaîne comme '2 ans 3 mois 18 jours ...'
Dim lAn As Long, lMois As Long, lJour As Long
Dim lHeure As Long, lMinute As Long, lSeconde As Long
Dim DateTemp As Date, Temp As String
' Remet les dates dans l'ordre si besoin : Date1 avant Date2
If maDate1 > maDate2 Then
DateTemp = maDate1
maDate1 = maDate2
maDate2 = DateTemp
End If
' L'inconvénient de DateDiff, c'est qu'il arrondi le résultat :
' Si on cherche le nombre d'années entre deux dates alors que _
ces dates ne sont séparées que de 11 mois, il renverra 1 an.
' Pour éviter cela, après avoir récupéré le nombre, on teste _
si la (Date1 + Nombre) > Date2, c'est qu'il y a eu un arrondi
' Dans ce cas, on enlève 1 et le tour est joué.
'--- Nombre d'années
lAn = DateDiff('yyyy', maDate1, maDate2)
If DateAdd('yyyy', lAn, maDate1) > maDate2 Then lAn = lAn - 1
' Décale la date d'autant
maDate1 = DateAdd('yyyy', lAn, maDate1)
'--- Nombre de mois
lMois = DateDiff('m', maDate1, maDate2)
If DateAdd('m', lMois, maDate1) > maDate2 Then lMois = lMois - 1
' Décale la date d'autant
maDate1 = DateAdd('m', lMois, maDate1)
'--- Nombre de jours
lJour = DateDiff('d', maDate1, maDate2)
If DateAdd('d', lJour, maDate1) > maDate2 Then lJour = lJour - 1
' Décale la date d'autant
maDate1 = DateAdd ('d', lJour, maDate1)
'--- Nombre d'heures
lHeure = DateDiff ('h', maDate1, maDate2)
If DateAdd ('h', lHeure, maDate1) > maDate2 Then lHeure = lHeure - 1
' Décale la date d'autant
maDate1 = DateAdd ('h', lHeure, maDate1)
'--- Nombre de minutes
lMinute = DateDiff ('n', maDate1, maDate2)
If DateAdd ('n', lMinute, maDate1) > maDate2 Then lMinute = lMinute - 1
' Décale la date d'autant
maDate1 = DateAdd ('n', lMinute, maDate1)
'--- Nombre de secondes
lSeconde = DateDiff ('s', maDate1, maDate2)
'Debug.Print lAn, lMois, lJour, lHeure, lMinute, lSeconde
' Mise en forme de la chaîne à renvoyer :
Temp = IIf (lAn > 0, CStr (lAn) & 'an(s) ', ''Â'Â')
Temp = Temp & IIf (lMois > 0, CStr (lMois) & ' mois ', ''Â'Â')
Temp = Temp & IIf (lJour > 0, CStr (lJour) & ' jours ', ''Â'Â')
Temp = Temp & IIf (lHeure > 0, CStr (lHeure) & ' heure(s) ', ''Â'Â')
Temp = Temp & IIf (lMinute > 0, CStr (lMinute) & 'minute (s) ', ''Â'Â')
Temp = Temp & IIf (lSeconde > 0, CStr (lSeconde) & 'seconde (s)', ''Â'Â')
Calc_Diff = Temp
End Function
