[AC-2007] Format différence date [Résolu]

[ulovb]

Bonjour,
J'aimerai pouvoir calculer la différence entre 2 dates et pouvoir les afficher sous un format spécifique.
exemple:
datedebut: 01/01/2010
datefin : 3/02/2011
différence : 1 an 1mois 03 jours
Merci.

[RobiPMS]

Bonjour.
Une proposition qui retourne un résultat en années mois jours, tient compte des années bissextiles et qui me semble tenir la route dans tous les cas de figure (sauf erreur de ma part ). J'en ai testé plusieurs autres, et je n'en ai pas trouvé de plus simple qui retourne un résultat exact.
Voici le code.
Dans un module :
D'abord la fonction (classique) pour tester si l'année est bissextile:

Code :

1
2
3
4
Public Function EstBissextile(ByVal lngAnnée As Long) As Boolean
  EstBissextile = ((lngAnnée Mod 4 = 0) And (lngAnnée Mod 100 <> 0)) _
    Or (lngAnnée Mod 400 = 0)
End Function

Puis la fonction qui affiche la différence en années mois jours

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Function Ageamj(DN As Date, dx As Date) As String
Dim Y1 As Long, Y2 As Long, M1 As Long, M2 As Long, D1 As Long, D2 As Long, D3 As Long
 
Y1 = Format(DN, "yyyy")
Y2 = Format(dx, "yyyy")
M1 = Format(DN, "m")
M2 = Format(dx, "m")
D1 = Format(DN, "d")
D2 = Format(dx, "d")
 
If D2 >= D1 Then
D3 = D2 - D1
ElseIf D2 < D1 And ((M2 = 1) Or (M2 = 2) Or (M2 = 4) Or (M2 = 6) Or (M2 = 8) Or (M2 = 9) Or (M2 = 11)) Then D3 = 31 - D1 + D2
ElseIf D2 < D1 And ((M2 = 5) Or (M2 = 7) Or (M2 = 10) Or (M2 = 12)) Then D3 = 30 - D1 + D2
ElseIf D2 < D1 And (M2 = 3) And (EstBissextile(Y2) = True) Then D3 = 29 - D1 + D2
ElseIf D2 < D1 And (M2 = 3) And (EstBissextile(Y2) = False) Then D3 = 28 - D1 + D2
End If
 
If M2 = M1 And D2 = D1 Then
Ageamj = (Y2 - Y1) & " ans"
ElseIf M2 < M1 And D2 > D1 Or (M2 < M1 And D2 = D1) Then Ageamj = (Y2 - Y1 - 1) & " a " & (12 + M2 - M1) & " m " & D3 & " j"
ElseIf M2 < M1 And D2 < D1 Or (M2 = M1 And D2 < D1) Then Ageamj = (Y2 - Y1 - 1) & " a " & (11 + M2 - M1) & " m " & D3 & " j"
ElseIf (M2 > M1 And D2 > D1) Or (M2 > M1 And D2 = D1) Or (M2 = M1 And D2 > D1) Then Ageamj = (Y2 - Y1) & " a " & (M2 - M1) & " m " & D3 & " j"
ElseIf (M2 > M1 And D2 < D1) Then Ageamj = (Y2 - Y1) & " a " & (M2 - M1 - 1) & " m " & D3 & " j"
End If
End Function

Je l'utilise pour calculer un âge, mais elle peut évidemment servir à calculer n'importe quelle différence entre deux dates. DN est la date la plus ancienne et dx ... l'autre date!
Si vous l'essayez, ça serait gentil de me faire un retour.
Cordialement.

[Triton972]

Bonjour ulovb,

Essaie cette fonction ...

Code :

1
2
3
4
5
6
7
Function Diff_Date(date1 As Date, date2 As Date) As String
On Error Resume Next
Diff_Date = "Erreur"
Diff_Date = DateDiff("yyyy", date1, date2) & " an " _
& (DateDiff("m", date1, date2) - ((DateDiff("yyyy", date1, date2)) * 12)) & " mois " _
& (DateDiff("d", date1, date2) - (DateDiff("d", DateSerial(Year(date1), Month(date1), Day(date1)), DateSerial(Year(date2), Month(date2), 1) - 1))) & " jours"
End Function

Je l'ai testée rapidement donc à vérifier avec des cas un peu tordus.
Je n'ai pas également géré les éventuelles anomalies (date de fin avant la date de début etc ...)
Attention également, si les arguments d'entrée sont des variables "date" à entrer en format US si les arguments sont en format "string" les entrer en format français ...
Bon courage !
Cordialement,

[RobiPMS]

Bonjour.

J'ai testé. Les résultats affichés sont pour le moins farfelus dans un cas sur deux.Premier problème : le nombre de jours retournés est simplement le nombre de jours de la date la plus récente. En plus, quand le nombre de mois de la date la plus ancienne est inférieur à l'autre, les mois sont affichés en négatif.
Exemple :
pour 20/05/2009 -02/07/1999 -> 10 an -2 mois 20 jours
A mon avis, à retravailler, ou à éviter.

Cordialement

[ulovb]

Merci à vous pour les codes proposés mais j'ai un souci, comment l'insérer à ma zone de texte (txtPériode) pour l'affichage.

[RobiPMS]

Bonjour.

Propriétés du Form ou de l'état -> source contrôle de ton textbox "txtPériode" : =Ageamj([le_champ_source_date1]; [le_champ_source_date2])
Date1 est la date la plus ancienne.
Cordialement.

[Triton972]

Re,

J'ai du aller un peu trop vite ...
Voilà une fonction qui devrait mieux fonctionner :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Function Diff_Date(Date1 As Date, Date2 As Date) As String      ' Date1 <= Date2
Dim Dt As Date
Dim inMois As Integer
Dim inJour As Integer
 
On Error Resume Next
Diff_Date = "Erreur"
    If Date1 > Date2 Then Exit Function
    If Date1 = Date2 Then Diff_Date = "0 jour": Exit Function
 
    If Day(Date1) > Day(Date2) Then
        inMois = 1
        Dt = DateSerial(Year(Date2), Month(Date2), 1) - 1
        inJour = DateDiff("d", DateSerial(Year(Dt), Month(Dt), Day(Date1)), Date2)
    Else
        inMois = 0
        inJour = DateDiff("d", DateSerial(Year(Date2), Month(Date2), Day(Date1)), Date2)
    End If
Diff_Date = (DateDiff("m", Date1, Date2) \ 12) & " an" & IIf((DateDiff("m", Date1, Date2) \ 12) > 1, "s ", " ") _
& (DateDiff("m", Date1, Date2) - (12 * (DateDiff("m", Date1, Date2) \ 12)) - inMois) & " mois " _
& inJour & " jour" & IIf(inJour > 1, "s", "")
End Function

Pour le plaisir de faire une fonction originale !(elle pourrait s'écrire en une seule instruction ...)
@+

[RobiPMS]

Bonjour Triton972.

Chouette! Le résultat retourné est effectivement maintenant toujours correct (en tout cas identique à celui retourné par ma fonction). Reste juste un petit souci avec ta fonction pour l'affichage du résultat pour les dates où les mois sont identiques et le jour date2<jour date1.
Ex : 13/12/2007-17/12/1998=9ans-1mois26jours au lieu de 8ans11mois26jours.
Cette discussion m'a en tout cas permis de vérifier, que ma fonction affiche bien un résultat correct, puisque, par des moyens différents, nous arrivons tous les deux aux mêmes valeurs.
Cordialement.

[ulovb]

Bonjour,
merci à Triton972 et à RobiPMS pour leur aide.
Ce forum m'aide énormément.

[Triton972]

Bonjour ulovb et RobiPMS,

Content d'avoir participé à cette discussion. Moins content de n'avoir pas assez vérifié mon code . Voici le dernier (j'espère qu'il passera les tests de RobiPMS avec succès !. A ce sujet je pense que tu pourrais optimiser le traitement lorsque DN>dx car il donne des résultats inattendus (ex : ageamj("27/2/1999","23/2/1999"))

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Function Diff_Date(Date1 As Date, Date2 As Date) As String      ' Date1 <= Date2
Dim Dt As Date
Dim inAnnee As Integer
Dim inMois As Integer
Dim inJour As Integer
 
On Error Resume Next
Diff_Date = "Erreur"
    If Date1 > Date2 Then Exit Function
    If Date1 = Date2 Then Diff_Date = "0 jour": Exit Function
 
    If Day(Date1) > Day(Date2) Then
            If Month(Date1) = Month(Date2) Then
                inAnnee = 1
            Else
                inAnnee = 0
            End If
        inMois = 1
        Dt = DateSerial(Year(Date2), Month(Date2), 1) - 1
        inJour = DateDiff("d", DateSerial(Year(Dt), Month(Dt), Day(Date1)), Date2)
    Else
        inMois = 0
        inJour = DateDiff("d", DateSerial(Year(Date2), Month(Date2), Day(Date1)), Date2)
    End If
Diff_Date = ((DateDiff("m", Date1, Date2) \ 12) - inAnnee) & " an" & IIf((DateDiff("m", Date1, Date2) \ 12) > 1, "s ", " ") _
& (DateDiff("m", Date1, Date2) - (12 * ((DateDiff("m", Date1, Date2) \ 12) - inAnnee)) - inMois) & " mois " _
& inJour & " jour" & IIf(inJour > 1, "s", "")
End Function

@+

[RobiPMS]

Exact, Triton972. Je vais intégrer la gestion de ce cas particulier. Moi, je m'en sers pour afficher un âge lors d'un examen médical, donc en théorie ça n'arrive jamais et je n'ai pas pensé à le faire. Mais tu as raison, je vais le faire de la même façon que toi.
Cordialement.