Bonjour à tous,

Pourriez-vous m'aider ? j'ai un souci dans mon code au niveau de la boucle.

Si je supprime la condition Else en fin de boucle, le code fonctionne mais si la valeur de la combobox n'est pas présente en colonne 4 alors je reçois une erreur.

Avez-vous une idée d'où proviendrait mon erreur ?

Merci d'avance pour votre aide.

Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
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
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
dlng = Range("C65536").End(xlUp).Row
 
For i = 27 To dlng
If Me.ComboBox13 = "" Then Exit Sub
date1 = Cells(i, 2).Value
date2 = Date
Duree = DateDiff("d", date1, date2)
If Duree > 2 And Cells(i, 4).Value = Me.ComboBox13.Value Then
Cells(i, 9).Value = Duree
rval = Cells(i, 5).Value
rpark = Cells(i, 4).Value
 
Dim strEnvoyer As String
strEnvoyer = "xxxxx@xxxx" ' Mailto: To
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)
MonMessage.To = strEnvoyer
MonMessage.Subject = "Emergency exit not controlled " & Date
 
    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 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 = Date: Cells(lig, 2) = 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