Rapport de message :*
 

Re: Calculs de dates en VBA

Titre du sujet : Re: Calculs de dates en VBA
par myDearFriend! le 30/05/2012 21:29:14

Bonsoir criscris11, le Forum,

Ta remarque me fait découvrir un effet très gênant de la fonction DateDiff() que je pensais pourtant connaître... (on en apprend tous les jours !).

Dans l'aide VBA sur DateDiff(), il y a une phrase d'apparence anodine, mais qui ne l'est visiblement pas tant que ça : "Lors de la comparaison des dates 31 décembre et 1er janvier de l'année suivante, DateDiff avec la valeur Année ("yyyy") renvoie 1, même si la différence est seulement d'un jour.".
Etonnant, non ?
Du coup, quelques tests me confirme que DateDiff() considère 1 AN d'écart entre le 31/12/2011 et le 01/01/2012 !!! De même, il trouve 1 MOIS d'écart entre le 31/05/2012 et le 01/06/2012 !!!

Il convient donc de rectifier le tir dans le code utilisé et je te propose la solution de contournement suivante à tester. Cette solution reprends notamment mon raisonnement d'origine qui partait d'un calcul de l'écart en mois, pour en déduire ensuite les années, puis les jours  (j'ai juste ajouté un test pour réajuster l'effet indésirable tel que constaté plus haut) :
Private Sub CalculValid()
Dim D1 As Date, D2 As Date
Dim cptMtot As Integer, cptA As Integer, cptM As Integer, cptJ As Integer
    'Les dates début et fin sont-elles présentes et valables ?
    On Error Resume Next
    D1 = CDate(txtDu.Text)
    D2 = CDate(txtAu.Text)
    On Error GoTo 0
    'Calcul durée
    If D1 <> 0 And D2 <> 0 Then
        cptMtot = DateDiff("m", D1, D2)      'Combien de mois entre les 2 dates ?
        If DateAdd("m", cptMtot, D1) > D2 Then cptMtot = cptMtot - 1    'Réajustement calcul
        cptA = cptMtot \ 12                         'déduction de l'écart en année
        cptM = cptMtot - cptA * 12                  'déduction de l'écart restant en mois
        cptJ = D2 - DateAdd("m", cptMtot, D1)    'déduction de l'écart restant en jours
       
        LabelAnnees = cptA
        LabelMois = cptM
        LabelJours = cptJ
    End If
End Sub

Cordialement,