Boucle For dans Userform

Version imprimable

Voir 40 message(s) de cette discussion en une page

23/06/2016, 18h03
vincent007

oui faudrait formater en standard la valeur que prend la textbox "date" dans le USF et non en format anglais, as-tu une idée ?
23/06/2016, 19h28
parmi

D'où proviennent les dates dans la feuille ? du Userform ?
Si oui, tu peux utiliser le contrôle Date & Time Picker ou MonthView qui vont toujours retourner une date valide.
23/06/2016, 19h30
vincent007

j'ai jamais vu le controle date et time picker, cela se trouve où dans les tools ?
23/06/2016, 19h45
parmi

Click droit sur la boîte à outils > Contrôles supplémentaires
Puis tu cherches et coches dans la liste Microsoft Date and Time Picker Control ou Microsoft MonthView Control.
Ils sera ajouté dans ta série de contrôles et tu pourras l'utiliser sur ton Userform.
Le DT Picker est probablement le meilleur choix pour toi puisqu'il est associé d'un genre de textbox pour contenir la date choisie.
Sa propriété .Value retourne la date dans les cellules de la feuille lorsque nécessaire.
24/06/2016, 12h08
vincent007

1 pièce(s) jointe(s)

Bonjour Parmi,

J'ai testé le date picker mais ce n'est pas ce qu'il me faut.

J'ai donc ajouté l'instruction suivante afin de formater la date.

Code:

Me.TextBox55 = Format(CDate(Me.TextBox55), "dd/mm/yyyy")

Ce qui donne au niveau de ma textbox le bon format :

Pièce jointe 213836

Mais ensuite dans la cellule ne reçoit pas la valeur au bon format:

6/24/2016

J'utilise Excel version En

As-tu une idée ?

J'ai testé ce code-ci, le format de mes dates est bon maintenant ( USF et Cellule ) cela fonctionne ( condition vrai ) mais que pour le 1er enregistrement, dès que je vide les valeurs contenues dans Combobox et textbox et que je recommence l'opération alors cela fonctionne plus. Le mail n'est envoyé.

Aurais-tu une idée d'où proviendrait le souci ?

code:

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Dim date1 As Date, date2 As Date, Duree As Integer, dlng As Integer, i As Integer
    Dim rval As String
    Dim rpark As String
    Dim strEnvoyer As String
    Dim OutMail As Object
    Dim MonOutlook As Object
    Dim MonMessage As Object
    Dim strBody As String
    Dim strSignature As String
 
    Set MonOutlook = CreateObject("Outlook.Application")
    Set MonMessage = MonOutlook.CreateItem(0)
    strEnvoyer = "xxxxxxxx" ' Mailto: To
    MonMessage.To = strEnvoyer
    MonMessage.Subject = "Emergency exit not controlled " & Date
    dlng = Range("C65536").End(xlUp).Row
 
    For i = 27 To dlng
 
        date1 = Cells(i, 2).Value
        date2 = Date
        Duree = DateDiff("d", date1, date2)
 
        If Duree > 3 And Cells(i, 4).Value = Me.ComboBox13.Value Then
            Cells(i, 9).Value = Duree
            rval = Cells(i, 5).Value
            rpark = Cells(i, 4).Value
 
            strSignature = MonMessage.HTMLBody
            strBody = strBody & "<table style=width:100%; cellpadding=20; cellspacing=1; border=1>"
            strBody = strBody & "<tr>"
            strBody = strBody & "<th>Parking</th>"
            strBody = strBody & "<th>Emergency exit not controlled</th>"
            strBody = strBody & "<th>Delay</th>"
            strBody = strBody & "</tr>"
            strBody = strBody & "<tr>"
            strBody = strBody & "<td align=center valign=middle>" & Replace(rpark, vbCrLf, "</td>")
            strBody = strBody & "<td align=center valign=middle>" & Replace(rval, vbCrLf, "</td>")
            strBody = strBody & "<td align=center valign=middle>" & Replace(Duree, vbCrLf, "</td>")
            strBody = strBody & "</tr>"
            strBody = strBody & "</table>"
       Else
         If Duree < 2 And Me.ComboBox13.Value <> Cells(i, 4).Value Then
            GoTo demande1
         End If
 
       End If
 
    Next i
 
    strBody = strBody & "<p style font-family=courier; font-size=24; style=color:#090909>" & "<b>" & "Best regards</b></p>"
    strBody = strBody & "<p style font-family=courier; font-size=24; style=color:#090909>" & UCase(Environ("USERNAME"))
 
    MonMessage.HTMLBody = strBody
    ThisWorkbook.Save
    MonMessage.Attachments.Add ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
    MonMessage.Send
    Set MonOutlook = Nothing
 
 
demande1:
    'Cherche la première ligne vide
    lig = Range("B" & Rows.Count).End(xlUp).Row + 1
 
    'Copie le parking choisi dans la colonne D
    Cells(lig, 4) = Me.ComboBox13
    If Me.ComboBox13 <> "" Then
        'Met la date et l'heure dans les colonne B et C
        Me.TextBox55 = Format(Now, "dd/mm/yyyy")
        Cells(lig, 2).Value = Me.TextBox55
        Me.TextBox103 = Time: Cells(lig, 3) = Me.TextBox103
    Else
        Exit Sub
    End If
 
    'Description de la sortie de secours
    EMERGENCY_EXIT = InputBox("Please enter the name of the emergency exit ", "Emergency exit ?")
    Me.TextBox57 = EMERGENCY_EXIT: Cells(lig, 5) = EMERGENCY_EXIT
    If Me.TextBox57 <> "" Then
        Cells(lig, 6) = "True"
    Else
        Cells(lig, 6) = "False"
    End If
 
    'CHECKED BY
    CHECKED_BY = InputBox("Please enter the name of the person who made the control ?")
    Me.TextBox60 = CHECKED_BY: Cells(lig, 7) = CHECKED_BY
 
    'Commentaires
    Comments = InputBox("please enter your comments ?")
    Me.TextBox59 = Comments: Cells(lig, 8) = Comments
End Sub

07/07/2016, 12h10
parmi

Tu n'as pas répondu à ceci...
D'où proviennent les dates sur la feuille ?

Dans ton code, peu importe ce qui se passe dans ta boucle, la partie demande1 va être exécutée...
Par contre, ce sera à la fin de ta boucle et non pas au fur et à mesure...
Mais comme l'événement est déclenché au changement du combobox, rien n'est encore inscrit dans les autres contrôles.

Si tu expliquais ce que fait ou devrait faire ton programme pour cette toute partie ?
De ce que je vois, dès que tu changes la valeur du combobox, tout est déclenché.
À quoi servent donc les autres contrôles et même le Userform ?
Ton code ne devrait-il pas être au niveau du bouton "Send reports" si tu tiens à utiliser le Userform ?

Bonjour Parmi,

J'ai légèrement adapté mon code et maintenant cela fonctionne comme je le désirait.

Le mail est bien envoyé quand il faut.

Code :

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Private Sub ComboBox13_Change()
Dim date1 As Date, date2 As Date, Duree As Integer, dlng As Integer, i As Integer
    Dim rval As String
    Dim rpark As String
    Dim strEnvoyer As String
    Dim OutMail As Object
    Dim MonOutlook As Object
    Dim MonMessage As Object
    Dim strBody As String
    Dim strSignature As String
demande1:
    'Cherche la première ligne vide
    lig = Range("B" & Rows.Count).End(xlUp).Row + 1
 
    'Copie le parking choisi dans la colonne D
    Cells(lig, 4) = Me.ComboBox13
    If Me.ComboBox13 <> "" Then
        'Met la date et l'heure dans les colonne B et C
        Me.TextBox55 = Format(Now, "dd/mm/yyyy")
        Cells(lig, 2).Value = Me.TextBox55
        Me.TextBox103 = Time: Cells(lig, 3) = Me.TextBox103
    Else
        Exit Sub
    End If
 
    'Description de la sortie de secours
    EMERGENCY_EXIT = InputBox("Please enter the name of the emergency exit ", "Emergency exit ?")
    Me.TextBox57 = EMERGENCY_EXIT: Cells(lig, 5) = EMERGENCY_EXIT
    If Me.TextBox57 <> "" Then
        Cells(lig, 6) = "True"
    Else
        Cells(lig, 6) = "False"
    End If
 
    'CHECKED BY
    CHECKED_BY = InputBox("Please enter the name of the person who made the control ?")
    Me.TextBox60 = CHECKED_BY: Cells(lig, 7) = CHECKED_BY
 
    'Commentaires
    Comments = InputBox("please enter your comments ?")
    Me.TextBox59 = Comments: Cells(lig, 8) = Comments
 
    Set MonOutlook = CreateObject("Outlook.Application")
    Set MonMessage = MonOutlook.CreateItem(0)
    strEnvoyer = "xxxxxxxx" ' Mailto: To
    MonMessage.To = strEnvoyer
    MonMessage.Subject = "Emergency exit not controlled " & Date
    dlng = Range("C65536").End(xlUp).Row
 
    For i = 27 To dlng
 
        date1 = Cells(i, 2).Value
        date2 = Date
        Duree = DateDiff("d", date1, date2)
 
        If Duree > 3 And Cells(i, 4).Value = Me.ComboBox13.Value And Cells(i, 5).Value = Me.TextBox57.Value Then
            Cells(i, 9).Value = Duree
            rval = Cells(i, 5).Value
            rpark = Cells(i, 4).Value
 
            strSignature = MonMessage.HTMLBody
            strBody = strBody & "<table style=width:100%; cellpadding=20; cellspacing=1; border=1>"
            strBody = strBody & "<tr>"
            strBody = strBody & "<th>Parking</th>"
            strBody = strBody & "<th>Emergency exit not controlled</th>"
            strBody = strBody & "<th>Delay</th>"
            strBody = strBody & "</tr>"
            strBody = strBody & "<tr>"
            strBody = strBody & "<td align=center valign=middle>" & Replace(rpark, vbCrLf, "</td>")
            strBody = strBody & "<td align=center valign=middle>" & Replace(rval, vbCrLf, "</td>")
            strBody = strBody & "<td align=center valign=middle>" & Replace(Duree, vbCrLf, "</td>")
            strBody = strBody & "</tr>"
            strBody = strBody & "</table>"
 
            strBody = strBody & "<p style font-family=courier; font-size=24; style=color:#090909>" & "<b>" & "Best regards</b></p>"
            strBody = strBody & "<p style font-family=courier; font-size=24; style=color:#090909>" & UCase(Environ("USERNAME"))
 
    MonMessage.HTMLBody = strBody
    ThisWorkbook.Save
    MonMessage.Attachments.Add ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
    MonMessage.Send
    Set MonOutlook = Nothing
 
 
 
     End If
 
    Next i
 
 
 
 
 
End Sub

Encore merci pour votre aide !

Voir 40 message(s) de cette discussion en une page