Calculer entre deux date en VBA

[maval]

Bonjours

J'ai un formulaire avec 10 textbox pour me donner entre deux date le Nbr de jours,de mois, d'années, trimestres ect... qui fonctionne a l'aide d'un commande bouton et j'aimerai que les textbox se remplisse automatiquement sans passer par le commande bouton.

Merci d'avance

Cordialement

Maval

 

[Theze]

Re : Calculer entre deux date en VBA

Bonjour,

Tu crée une Proc (ici DiffDate) que tu appelle sur l'évènement "Exit" des deux TextBox :

Private Sub CommandButton1_Click()

    Unload Me

End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    DiffDate
    
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    DiffDate

End Sub


Private Sub DiffDate()
    
    On Error GoTo Fin 'gère l'erreur du textbox par encore rempli
    
    TextBox3 = DateDiff("d", TextBox1.Value, TextBox2.Value, 2, 2) & " jours"
    TextBox4 = DateDiff("m", TextBox1.Value, TextBox2.Value, 2, 2) & " Mois"
    TextBox5 = DateDiff("ww", TextBox1.Value, TextBox2.Value, 2, 2) & " Semaine(s)"
    TextBox6 = DateDiff("q", TextBox1.Value, TextBox2.Value, 2, 2) & " Trimestre(s)"
    TextBox7 = DateDiff("yyyy", TextBox1.Value, TextBox2.Value, 2, 2) & " Année(s)"
    TextBox8 = DateDiff("h", TextBox1.Value, TextBox2.Value, 2, 2) & " Heure(s)"
    TextBox9 = DateDiff("n", TextBox1.Value, TextBox2.Value, 2, 2) & " Minutes(s)"
    TextBox10 = DateDiff("s", TextBox1.Value, TextBox2.Value, 2, 2) & " Seconde(s)"
    
Fin:

End Sub

Hervé.

 

[maval]

Re : Calculer entre deux date en VBA

Bonjour Hervé,

Sa fonctionne Nickel! mais pourquoi si je marque la date en format comme ceci (dddd DD mmmm yyYY")sa ne fonctionne pas ?

merci et bonne journée

Max

 

[Theze]

Re : Calculer entre deux date en VBA

Re,

Le compilateur ne reconnaît pas les dates sous ce format (surtout en Français enfin, pas à ma connaissance mais je peux me tromper) donc, il te faut la transformer en un format qu'il soit capable de reconnaître. Je te propose une petite fonction vite faite et qui ne fonctionne qu'avec un format de date comme ceci "dimanche 24 février 2013" mais rien ne t'empêche de la faire évoluer pour plus de souplesse :

Private Sub CommandButton1_Click()

    Unload Me

End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
    If TextBox1.Text <> "" And TextBox2.Text <> "" Then DiffDate
    
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    If TextBox1.Text <> "" And TextBox2.Text <> "" Then DiffDate

End Sub


Private Sub DiffDate()

    Dim DateDebut As Date
    Dim DateFin As Date
    
    'gère l'erreur de la date entrée de cette façon : dimanche 24 février 2013
    On Error Resume Next
    DateDebut = CDate(TextBox1.Value)
    
    'reconstitue la date de façon à ce que le compilateur puisse la reconnaître
    If Err.Number <> 0 Then DateDebut = Deformater(TextBox1.Value)
    
    'remet à 0 pour la date suivante
    Err.Number = 0
    DateFin = CDate(TextBox2.Value)
    
    'idem que plus haut
    If Err.Number <> 0 Then DateFin = Deformater(TextBox2.Value)
    
    On Error GoTo 0 'supprime le gestionnaire
    
    On Error GoTo Fin 'remet en place un gestionnaire pour gérer l'erreur du textbox par encore rempli
    
    TextBox3 = DateDiff("d", DateDebut, DateFin, 2, 2) & " jours"
    TextBox4 = DateDiff("m", DateDebut, DateFin, 2, 2) & " Mois"
    TextBox5 = DateDiff("ww", DateDebut, DateFin, 2, 2) & " Semaine(s)"
    TextBox6 = DateDiff("q", DateDebut, DateFin, 2, 2) & " Trimestre(s)"
    TextBox7 = DateDiff("yyyy", DateDebut, DateFin, 2, 2) & " Année(s)"
    TextBox8 = DateDiff("h", DateDebut, DateFin, 2, 2) & " Heure(s)"
    TextBox9 = DateDiff("n", DateDebut, DateFin, 2, 2) & " Minutes(s)"
    TextBox10 = DateDiff("s", DateDebut, DateFin, 2, 2) & " Seconde(s)"
    
Fin:

End Sub

Function Deformater(LaDate As String) As Date

    Dim Jour As Long
    Dim Mois As String
    Dim Annee As Long
        
    Select Case LCase(Split(LaDate, " ")(2))
    
        Case "janvier": Mois = 1
        Case "février": Mois = 2
        Case "mars": Mois = 3
        Case "avril": Mois = 4
        Case "mai": Mois = 5
        Case "juin": Mois = 6
        Case "juillet": Mois = 7
        Case "août": Mois = 8
        Case "septembre": Mois = 9
        Case "octobre": Mois = 10
        Case "novembre": Mois = 11
        Case "décembre": Mois = 12
        
    End Select
        
    Jour = Split(LaDate, " ")(1)
    
    Annee = Split(LaDate, " ")(3)
    
    Deformater = CDate(Jour & "/" & Mois & "/" & Annee)

End Function

Hervé.

 

[maval]

Re : Calculer entre deux date en VBA

Bonjour Hervé,

Je vais voir cela je te remercie et te souhaite une bonne journée.

Max