Calcule entre 2 dates

Commenter

Contenu du snippet

Permet d avoir en heure, minute , seconde et en annee, mois, jour la difference entre 2 dates ....

La date doit etre de la forme : jj/mm/aaaa
L'heure doit etre de la forme : hh/mm/ss

Utilisation :
Calc_Diff_Time "01/05/2002", "12:00:00", "02/05/2005", "15:00:00",lAn , lMois, lJour, lHeure, lMinute, lSeconde

PS: j ai recupere le code à jack ....merci!

Source / Exemple : 


Public Sub Calc_Diff_Time(sDate_1 As String, ByVal sHeure_1 As String, _
                          sDate_2 As String, ByVal sHeure_2 As String, _
                          lAn As Long, lMois As Long, lJour As Long, _
                          lHeure As Long, lMinute As Long, lSeconde As Long)
    ' Format de la date : jj/mm/aaaa
    ' Format de l'heure : hh:mm:ss
    
    Dim Date1 As Date, Date2 As Date, DateTemp As Date
    
    If (sDate_1 = "" And sDate_2 = "" And _
        sHeure_1 = "" And sHeure_2 = "") Then Exit Sub
    
    If (sDate_1 = "") Then sDate_1 = Date
    If (sDate_2 = "") Then sDate_2 = Date
    If (sHeure_1 = "") Then sHeure_1 = Hour(Time) & ":" & Minute(Time) & ":00"
    If (sHeure_2 = "") Then sHeure_2 = Hour(Time) & ":" & Minute(Time) & ":00"
    
    Date1 = sDate_1 & " " & sHeure_1
    Date2 = sDate_2 & " " & sHeure_2
    
    ' Remet les dates dans l'ordre si besoin : Date1 avant Date2
    If Date1 > Date2 Then
        DateTemp = Date1
        Date1 = Date2
        Date2 = 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", Date1, Date2)
    If DateAdd("yyyy", lAn, Date1) > Date2 Then lAn = lAn - 1
    ' Décale la date d'autant
    Date1 = DateAdd("yyyy", lAn, Date1)
    
    '--- Nombre de mois
    lMois = DateDiff("m", Date1, Date2)
    If DateAdd("m", lMois, Date1) > Date2 Then lMois = lMois - 1
    ' Décale la date d'autant
    Date1 = DateAdd("m", lMois, Date1)
    
    '--- Nombre de jours
    lJour = DateDiff("d", Date1, Date2)
    If DateAdd("d", lJour, Date1) > Date2 Then lJour = lJour - 1
    ' Décale la date d'autant
    Date1 = DateAdd("d", lJour, Date1)
    
    '--- Nombre d'heures
    lHeure = DateDiff("h", Date1, Date2)
    If DateAdd("h", lHeure, Date1) > Date2 Then lHeure = lHeure - 1
    ' Décale la date d'autant
    Date1 = DateAdd("h", lHeure, Date1)
    
    '--- Nombre de minutes
    lMinute = DateDiff("n", Date1, Date2)
    If DateAdd("n", lMinute, Date1) > Date2 Then lMinute = lMinute - 1
    ' Décale la date d'autant
    Date1 = DateAdd("n", lMinute, Date1)
    
    '--- Nombre de secondes
    lSeconde = DateDiff("s", Date1, Date2)
End Sub

Conclusion :


J attends vos commentaires .... :-/

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Seth77)