Calcul d'une différence entre 2 dates dans un userform

Le 25/12/2009 à 23:50

Bonjour à tous

Voila, j'ai un userform avec 3 textbox

dans le textbox1 je rentre une date

dans le textbox2 je rentre une autre date (ou rien)

dans le texbox3 je souhaite avoir le délai en mois et jours entre le textbox1 et le texbox2 sachant que si le textbox2 est vide c'est la date du jour qui doit être prise en compte par déffaut.

D'avance merci pour l'aide sur le code nécéssaire

Le 26/12/2009 à 17:16

Bonjour arobase, forum,

Essaie ce code :

code supprimé, petite erreur

Ce code suppose l'existence d'un bouton "CommandButton1" dans ton userform.

-- 26 Déc 2009 18:43 --

Voici le nouveau code :

Private Sub CommandButton1_Click()
    TextBox3 = ""
    If Not (IsDate(TextBox1) Or IsDate(TextBox2)) Then
        MsgBox "Format incorrect"
        TextBox1 = ""
        TextBox2 = ""
        Exit Sub
    Else
        If TextBox2 = "" Then TextBox2 = Date
        If CDate(TextBox2) <= CDate(TextBox1) Then
            MsgBox "Attention! Date 2 inférieure ou égale à date 1", vbExclamation
            Exit Sub
        End If
        date1 = Format(TextBox1, "mm/dd/yyyy")
        date2 = Format(TextBox2, "mm/dd/yyyy")
        jour = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""md"")")
        mois = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""m"")")
        TextBox3 = mois & " mois et " & jour & " jour(s)"
    End If
End Sub
Le 26/12/2009 à 21:12

Bonjour et merci de ton aide VBa News

Cela ne fonctionne pas...

voici le code que j'ai adapté suite à ton aide (je suis très débutant en vba)

mes 3 textbox s'apellent:

dateenregistrement1/datevalidation1/delaimission1

Private Sub CommandButton1_Click()

Sub Lance()

Load UserForm1

UserForm1.Show

delaimission1 = ""

If Not (IsDate(dateenregistrement1) Or IsDate(datevalidation1)) Then

MsgBox "Format incorrect"

dateenregistrement1 = ""

datevalidation1 = ""

Exit Sub

Else

If datevalidation1 = "" Then datevalidation1 = Date

If CDate(datevalidation1) <= CDate(dateenregistrement1) Then

MsgBox "Attention! Date 2 inférieure ou égale à date 1", vbExclamation

Exit Sub

End If

date1 = Format(dateenregistrement1, "mm/dd/yyyy")

date2 = Format(datevalidation1, "mm/dd/yyyy")

jour = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""md"")")

mois = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""m"")")

delaimission1 = mois & " mois et " & jour & " jour(s)"

End If

End Sub

encore merci de ton aide

Le 26/12/2009 à 22:00
Arobase72 a écrit :

Cela ne fonctionne pas...

Cela dépend en effet du nom de tes textbox.

Par contre tu as deux "Sub" dans ton code.

Dans un module, mets ce code :

Sub lance()
UserForm1.Show
End Sub

Puis dans le code de ton userform1, mets celui-ci :

Private Sub CommandButton1_Click()
    delaimission1 = ""
    If Not (IsDate(dateenregistrement1) Or IsDate(datevalidation1)) Then
        MsgBox "Format incorrect"
        dateenregistrement1 = ""
        datevalidation1 = ""
        Exit Sub
    Else
        If datevalidation1 = "" Then datevalidation1 = Date
        If CDate(datevalidation1) <= CDate(dateenregistrement1) Then
            MsgBox "Attention! Date 2 inférieure ou égale à date 1", vbExclamation
            Exit Sub
        End If
        date1 = Format(dateenregistrement1, "mm/dd/yyyy")
        date2 = Format(datevalidation1, "mm/dd/yyyy")
        jour = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""md"")")
        mois = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""m"")")
        delaimission1 = mois & " mois et " & jour & " jour(s)"
    End If
End Sub

Normalement, le calcul sur les dates devrait être juste. Si jamais tu rencontres un problème dans le résultat du calcul, reviens.

Le 27/12/2009 à 16:24

re bonjour,

Non cela ne fonctionne tjs pas .

J'ai joint un "extrait" de mon userform pour que ton aide (précieuse) puisse y voir + clair

Encore un grand merci

389fichierforum5.7z (54.04 Ko)
Le 27/12/2009 à 18:24

Salut le forum

Merci de joindre une version au format .Zip

Tous n'ont pas 7-Zip comme décompresseur de fichier

Mytå

Le 27/12/2009 à 18:39

Re,

Arobase72 a écrit :

Non cela ne fonctionne tjs pas .

C'est normal, le bouton qui te permet de valider ton userform s'appelle CommandButton3 et pas CommandButton1

Remplace le code du CommandButton3 par celui-ci :

Private Sub CommandButton3_Click()
    For i = 1 To 4
        Me.Controls("delaimission" & i) = ""
        If Me.Controls("dateenregistrement" & i) <> "" And Me.Controls("datevalidation" & i) <> "" Then
            If Not (IsDate(Me.Controls("dateenregistrement" & i)) Or IsDate(Me.Controls("datevalidation" & i))) Then
                MsgBox "Format incorrect"
                Me.Controls("dateenregistrement" & i) = ""
                Me.Controls("datevalidation" & i) = ""
                Exit Sub
            Else
                If Me.Controls("datevalidation" & i) = "" Then Me.Controls("datevalidation" & i) = Date
                If CDate(Me.Controls("datevalidation" & i)) <= CDate(Me.Controls("dateenregistrement" & i)) Then
                    MsgBox "Attention! Date 2 inférieure ou égale à date 1", vbExclamation
                    Exit Sub
                End If
                date1 = Format(Me.Controls("dateenregistrement" & i), "mm/dd/yyyy")
                date2 = Format(Me.Controls("datevalidation" & i), "mm/dd/yyyy")
                jour = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""md"")")
                mois = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""m"")")
                Me.Controls("delaimission" & i) = mois & " mois et " & jour & " jour(s)"
            End If
        End If
    Next i
    rep = MsgBox("Continuer la saisie ?", vbYesNo)
    If rep = vbYes Then Exit Sub

    'inscription des données récupérées du formulaire validé dans la feuille excel
    'sélection de la ligne sur laquelle écrire (la première vide)
    num = Sheets("Base").Range("B65536").End(xlUp).Row + 1
    'on part du bas de la colonne, on cherche
    'la première cellule non vide avec end(xlup), on renvoie son N° avec row et on ajoute 1 pour avoir le numéro de la
    'ligne d'en dessous

    Sheets("Base").Activate
    Range("A" & num).Value = dateenregistrement1
    Range("B" & num).Value = datevalidation1
    Range("C" & num).Value = delaimission1
    Range("D" & num).Value = dateenregistrement2
    Range("E" & num).Value = datevalidation2
    Range("F" & num).Value = delaimission2
    Range("G" & num).Value = dateenregistrement3
    Range("H" & num).Value = datevalidation3
    Range("I" & num).Value = delaimission3
    Range("J" & num).Value = dateenregistrement4
    Range("K" & num).Value = datevalidation4
    Range("L" & num).Value = delaimission4
    Unload Me
    UserForm1.Show
End Sub

Au milieu du code je t'ai mis un :

    rep = MsgBox("Continuer la saisie ?", vbYesNo)
    If rep = vbYes Then Exit Sub

Pour choisir si tu continues la saisie ou pas, car normalement, en validant l'userform, les données sont directement copiées sur la feuille excel. Sans avoir eu le temps de voir sur ton userform le calcul des différents délais.

A toi de voir ce que tu souhaites obtenir.

Le 28/12/2009 à 00:54

Génial, merci beaucoup !!!

Est il possible si on entre une donnée "date d'enregistrement" sans "date de validation" d'avoir le délai entre cette première date et aujourdh'ui?

Désolé pour le ZIP 7 mais c'est tout ce que j'ai trouvé comme compression pour faire tenir mon fichier en moins de 120Ko.

Le 28/12/2009 à 10:12

Re,

Arobase72 a écrit :

Génial, merci beaucoup !!!

Ya pas de quoi

Arobase72 a écrit :

Est il possible si on entre une donnée "date d'enregistrement" sans "date de validation" d'avoir le délai entre cette première date et aujourdh'ui?

Oui c'est possible, remplace le début du code du CommandButton3 par celui-ci :

Private Sub CommandButton3_Click()
    On Error GoTo CommandButton3_Click_Error

    For i = 1 To 4
        Me.Controls("delaimission" & i) = ""
        If Me.Controls("dateenregistrement" & i) <> "" Or Me.Controls("datevalidation" & i) <> "" Then
            If Me.Controls("dateenregistrement" & i) <> "" And Me.Controls("datevalidation" & i) = "" Then
                Me.Controls("datevalidation" & i) = Date
            End If
            If Not IsDate(Me.Controls("dateenregistrement" & i)) Or Not IsDate(Me.Controls("datevalidation" & i)) Then
                MsgBox "Format ligne " & i & " incorrect"
                Me.Controls("dateenregistrement" & i) = ""
                Me.Controls("datevalidation" & i) = ""
                Exit Sub
            Else
                If CDate(Me.Controls("datevalidation" & i)) <= CDate(Me.Controls("dateenregistrement" & i)) Then
                    MsgBox "Attention! Sur la ligne " & i & ", date 2 inférieure ou égale à date 1", vbExclamation
                Else
                    date1 = Format(Me.Controls("dateenregistrement" & i), "mm/dd/yyyy")
                    date2 = Format(Me.Controls("datevalidation" & i), "mm/dd/yyyy")
                    jour = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""md"")")
                    mois = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""m"")")
                    Me.Controls("delaimission" & i) = mois & " mois et " & jour & " jour(s)"
                    'Exit Sub
                End If
            End If
        End If
    Next i
    rep = MsgBox("Continuer la saisie ?", vbYesNo)
    If rep = vbYes Then Exit Sub

    'inscription des données récupérées du formulaire validé dans la feuille excel
    'sélection de la ligne sur laquelle écrire (la première vide)
    num = Sheets("Base").Range("B65536").End(xlUp).Row + 1
    'on part du bas de la colonne, on cherche
    'la première cellule non vide avec end(xlup), on renvoie son N° avec row et on ajoute 1 pour avoir le numéro de la
    'ligne d'en dessous

    Sheets("Base").Activate
    Range("A" & num).Value = dateenregistrement1
    Range("B" & num).Value = datevalidation1
    Range("C" & num).Value = delaimission1
    Range("D" & num).Value = dateenregistrement2
    Range("E" & num).Value = datevalidation2
    Range("F" & num).Value = delaimission2
    Range("G" & num).Value = dateenregistrement3
    Range("H" & num).Value = datevalidation3
    Range("I" & num).Value = delaimission3
    Range("J" & num).Value = dateenregistrement4
    Range("K" & num).Value = datevalidation4
    Range("L" & num).Value = delaimission4
    Unload Me
    UserForm1.Show

    On Error GoTo 0
    Exit Sub

CommandButton3_Click_Error:

    MsgBox "Erreur " & Err.Number & " (" & Err.Description & ") dans la procedure CommandButton3_Click du UserForm1"
End Sub

J'ai ajouté une procédure de gestion d'erreur au cas où tu en rencontres. Le code devrait marcher dans la majorité des cas.

Le 28/12/2009 à 17:20

Ca marche NICKEL !!!!!!

Un très très très grand merci Vba-news pour ton aide.......et ta patience !!:D

Le 28/12/2009 à 22:59

Si ton problème est résolu, indique-le. Ya une petite flèche verte sur laquelle cliquer je ne sais plus trop où!

Le 02/01/2010 à 16:43

Bonjour à tous

Bon, ça fonctionne quand j'enregistre une nouvelle fiche, mais quand je modifie la date de "fin de mission" le délai ne se met pas à jour....

J'ai essayé de faire un "copié collé" du code dans mon bouton "enregistrer les modifs" mais la mise à jour ne fonctionne pas

y'a t'il une solution à cela?

code de mon bouton "enregistrer les modifs:

Private Sub Enregistremodifs_Click()
   For i = 1 To 4
        Me.Controls("delaimission" & i) = ""
        If Me.Controls("dateenregistrement" & i) <> "" And Me.Controls("datevalidation" & i) <> "" Then
            If Not (IsDate(Me.Controls("dateenregistrement" & i)) Or IsDate(Me.Controls("datevalidation" & i))) Then
                MsgBox "Format incorrect"
                Me.Controls("dateenregistrement" & i) = ""
                Me.Controls("datevalidation" & i) = ""
                Exit Sub
            Else
                If Me.Controls("datevalidation" & i) = "" Then Me.Controls("datevalidation" & i) = Date
                If CDate(Me.Controls("datevalidation" & i)) <= CDate(Me.Controls("dateenregistrement" & i)) Then
                    MsgBox "Attention! Date 2 inférieure ou égale à date 1", vbExclamation
                    Exit Sub
                End If
                date1 = Format(Me.Controls("dateenregistrement" & i), "mm/dd/yyyy")
                date2 = Format(Me.Controls("datevalidation" & i), "mm/dd/yyyy")
                jour = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""md"")")
                mois = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""m"")")
                Me.Controls("delaimission" & i) = mois & " mois et " & jour & " jour(s)"
            End If
        End If
    Next i
N°dedossier = Cells(ComboBox1.ListIndex + 2, 1)
N°Ligne = N°dedossier + 1
With UserForm1
    Range("C" & N°Ligne).Value = .Civilite
    Range("E" & N°Ligne).Value = .Prenom
    Range("D" & N°Ligne).Value = .Nom

   Unload Me
UserForm1.Show
End With

End Sub
Le 02/01/2010 à 17:26

Bonjour arobase, forum,

Il faudrait que l'on travaille sur le même fichier! Car je ne comprends pas bien les problèmes que tu rencontres.

Si possible, joins un bout du fichier sur lequel tu travailles.

Le 02/01/2010 à 18:41

Que ferais je sans toi VB news , que tu en sois mille fois remercié.....

voici le fichier

95forumdates.7z (77.20 Ko)
Le 02/01/2010 à 19:21

Re,

Il manque ce bout de code :

    rep = MsgBox("Continuer la saisie ?", vbYesNo)
    If rep = vbYes Then Exit Sub

dans le code de "Enregistfiche_Click" ; voici le code modifié :

Private Sub Enregistfiche_Click()
    For i = 1 To 4
        Me.Controls("delaimission" & i) = ""
        If Me.Controls("dateenregistrement" & i) <> "" And Me.Controls("datevalidation" & i) <> "" Then
            If Not (IsDate(Me.Controls("dateenregistrement" & i)) Or IsDate(Me.Controls("datevalidation" & i))) Then
                MsgBox "Format incorrect"
                Me.Controls("dateenregistrement" & i) = ""
                Me.Controls("datevalidation" & i) = ""
                Exit Sub
            Else
                If Me.Controls("datevalidation" & i) = "" Then Me.Controls("datevalidation" & i) = Date
                If CDate(Me.Controls("datevalidation" & i)) <= CDate(Me.Controls("dateenregistrement" & i)) Then
                    MsgBox "Attention! Date 2 inférieure ou égale à date 1", vbExclamation
                    Exit Sub
                End If
                date1 = Format(Me.Controls("dateenregistrement" & i), "mm/dd/yyyy")
                date2 = Format(Me.Controls("datevalidation" & i), "mm/dd/yyyy")
                jour = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""md"")")
                mois = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""m"")")
                Me.Controls("delaimission" & i) = mois & " mois et " & jour & " jour(s)"
            End If
        End If
    Next i
    rep = MsgBox("Continuer la saisie ?", vbYesNo)
    If rep = vbYes Then Exit Sub

    'inscription des données récupérées du formulaire validé dans la feuille excel
    'sélection de la ligne sur laquelle écrire (la première vide)
    num = Sheets("Base").Range("C65536").End(xlUp).Row + 1
    'on part du bas de la colonne, on cherche
    'la première cellule non vide avec end(xlup), on renvoie son N° avec row et on ajoute 1 pour avoir le numéro de la
    'ligne d'en dessous

    Sheets("Base").Activate
    Range("C" & num).Value = Civilite

    Range("E" & num).Value = Prenom

    Range("D" & num).Value = Nom    ' J'ai remis la ligne Nom à la fin pour qu'elle soit également enregistrée si tu devais modifier l'orthographe de Nom
    Range("X" & num).Value = dateenregistrement1
    Range("Y" & num).Value = datevalidation1

    Range("AC" & num).Value = dateenregistrement2
    Range("AD" & num).Value = datevalidation2

    Range("AH" & num).Value = dateenregistrement3
    Range("AI" & num).Value = datevalidation3

    Range("AM" & num).Value = dateenregistrement4
    Range("AN" & num).Value = datevalidation4
    Range("BJ" & num).Value = delaimission1
    Range("BM" & num).Value = delaimission2
    Range("BP" & num).Value = delaimission3
    Range("BS" & num).Value = delaimission4
    Range("B1:BS5000").Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlYes, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                   DataOption1:=xlSortNormal

    Unload Me
    UserForm1.Show

End Sub
Le 02/01/2010 à 20:40

Merci VB news mais c'est à mon avis dans le bouton "Modif enregistrement" qu'il faut modifier quelquechose.

En effet, par exemple il y à 6 mois j'ai enregistré la fiche de MrDURAND avec une date d'enregistrement (06/06/2009), aujourdh'hui je souhaite entrer la date de validation , donc je rapelle la fiche de M.Durand avec le combo, je rentre 02/01/2010 en date de validation. Il faut donc que je clic sur le bouton "enregistrer les modifs" pour qu'il me calcule le délai entre les 2 dates. Peut importe si ce délai ne s'affiche pas de suite dans le usf, l'important est que cela s'enregistre dans la feuille "Base" (et donc qu'il apparaisse si je rapelle une autre fois cette fiche.

A+

Le 03/01/2010 à 12:47

Essaie en remplaçant le code de "Enregistremodifs_Click" par celui-ci :

Private Sub Enregistremodifs_Click()

    N°dedossier = Cells(ComboBox1.ListIndex + 2, 1)
    N°Ligne = N°dedossier + 1
    For i = 1 To 4
        Me.Controls("delaimission" & i) = ""
        If Me.Controls("dateenregistrement" & i) <> "" And Me.Controls("datevalidation" & i) <> "" Then
            If Not (IsDate(Me.Controls("dateenregistrement" & i)) Or IsDate(Me.Controls("datevalidation" & i))) Then
                MsgBox "Format incorrect"
                Me.Controls("dateenregistrement" & i) = ""
                Me.Controls("datevalidation" & i) = ""
                Exit Sub
            Else
                If Me.Controls("datevalidation" & i) = "" Then Me.Controls("datevalidation" & i) = Date
                If CDate(Me.Controls("datevalidation" & i)) <= CDate(Me.Controls("dateenregistrement" & i)) Then
                    MsgBox "Attention! Date 2 inférieure ou égale à date 1", vbExclamation
                    Exit Sub
                End If
                date1 = Format(Me.Controls("dateenregistrement" & i), "mm/dd/yyyy")
                date2 = Format(Me.Controls("datevalidation" & i), "mm/dd/yyyy")
                jour = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""md"")")
                mois = Evaluate("DATEDIF(""" & date1 & """,""" & date2 & """,""m"")")
                Me.Controls("delaimission" & i) = mois & " mois et " & jour & " jour(s)"
            End If
        End If
    Next i
    With UserForm1
        Range("C" & N°Ligne).Value = .Civilite
        '    Range("D" & N°Ligne).Value = .Nom ' J'ai supprimé cette ligne de cette position car c'est elle qui pose pb, en effet dès que Nom change la fonction Private Sub ComboBox1_Change() se déclanche et remet tout ce qui suit à l'ancienne valeur
        Range("E" & N°Ligne).Value = .Prenom

        Range("X" & N°Ligne).Value = .dateenregistrement1
        Range("Y" & N°Ligne).Value = .datevalidation1

        Range("AC" & N°Ligne).Value = .dateenregistrement2
        Range("AD" & N°Ligne).Value = .datevalidation2

        Range("AH" & N°Ligne).Value = .dateenregistrement3
        Range("AI" & N°Ligne).Value = .datevalidation3

        Range("AM" & N°Ligne).Value = .dateenregistrement4
        Range("AN" & N°Ligne).Value = .datevalidation4

        Range("BJ" & N°Ligne).Value = delaimission1
        Range("BM" & N°Ligne).Value = delaimission2
        Range("BP" & N°Ligne).Value = delaimission3
        Range("BS" & N°Ligne).Value = delaimission4
        Range("D" & N°Ligne).Value = .Nom    ' J'ai remis la ligne Nom à la fin pour qu'elle soit également enregistrée si tu devais modifier l'orthographe de Nom

        Range("B1:BS5000").Select
        Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlYes, _
                       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                       DataOption1:=xlSortNormal
        Unload Me
        UserForm1.Show
    End With

End Sub

J'ai changé la place de la boucle For...Next.

J'ai également changé la place de la ligne concernant le Nom.

Le 03/01/2010 à 15:08

Mille Merci !!!!!

Ca marche super....

Bonne journée à toi !

Rechercher des sujets similaires à "calcul difference entre dates userform"