Multiples boucles imbriquées, suis-je sur la bonne voie ?

**dmoluc** · 20/08/2012, 17h45

Bonjour à tous,

Cela fait quelques temps que je n'ai pas eu recourt au forum, j'essais de me débrouiller seul, mais depuis quelques jour je bute sur un problème: tant bien que mal j'ai réussis à faire fonctionner plusieurs boucles imbriquées, sauf une qui ne fonctionne qu'une fois.

Voilà le problème :
Sur un UserForm j'ai des listbox et des textbox dont je veux écrire les valeurs sur une feuille excel
voici une capture d'écran

J'ai trois catégories de listbox personnels, fournitures et matériels (ordre dans le code) les listbox = désignation et les textbox qui les accompagnes représente les quantités

Code :

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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Dim stcolonne As Long
 Dim z As Long
Dim Q As Double
Dim A
Dim Lig As Long
 For i = 11 To 34 'les listbox
 For z = 115 To 137 'les textbox
        Select Case i
        Case 11 To 16
           Select Case z
           Case 115 To 120
 
            A = Me("ListBox" & i).Text 'valeur de la listbox
 
            stcolonne = Colonne 'je  stock la valeur de la colonne trouvé précédament dans le code car dans la zone graphique du diagramme j'écrit des 1 qui vont me servir de condition dans mes boucles et pour cela j'ai besoin de la colonne de départ de la tâche
 
            If Application.CountIf(Range("A39:A45"), "=" & A) <> 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
'si A est déjà écrit sur la feuille, je recherche la ligne ou il est écrit
                Ligne = Application.Match(A, Columns(1), 0)
               Q = CDbl(Me.Controls("TextBox" & z).Value) ' J'incrémente la valeur de la TextBox qui correspond à la listbox du dessus
                compteur = 0
                Lig = Range("A36").End(xlUp).Row ' je cherche la ligne ou la tâche est écrite pour vérifier les cellule qui ont des 1 et je fais une boucle pour écrire les quantités
               While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
Colonne = stcolonne
                ElseIf Application.CountIf(Range("A39:A45"), "=" & A) = 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
'c'est la même chose qu'en haut mais cette fois-ci A n'est pas sur la feuille et je dois l'écrire
                Range("A45").End(xlUp).Offset(1, 0) = A
                Ligne = Range("A45").End(xlUp).Row
               Q = CDbl(Me.Controls("TextBox" & z).Value)
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
               While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
            End If
 
          End Select
          Le code est répété 3 fois pour les trois plage de la feuille
        Case 17 To 26
 
           Select Case z
           Case 121 To 129
            A = Me("ListBox" & i).Text
            Colonne = stcolonne
            If Application.CountIf(Range("A87:A128"), "=" & A) <> 0 And A <> "" And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Ligne = Application.Match(A, Columns(1), 0)
               Q = CDbl(Me.Controls("TextBox" & z).Value)
               Q = Q / TextBox113.Value
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
               While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
                ElseIf Application.CountIf(Range("A87:A128"), "=" & A) = 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Range("A128").End(xlUp).Offset(1, 0) = A
                Colonne = stcolonne
                Ligne = Range("A128").End(xlUp).Row
               Q = CDbl(Me.Controls("TextBox" & z).Value)
               Q = Q / TextBox113.Value
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
               While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
            End If
          End Select
 
                Case 27 To 34
                   Select Case z
           Case 130 To 137
            A = Me("ListBox" & i).Text
            Colonne = stcolonne
              If Application.CountIf(Range("A49:A83"), "=" & A) <> 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Ligne = Application.Match(A, Columns(1), 0)
                Q = CDbl(Me.Controls("TextBox" & z).Value)
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
                While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
                ElseIf Application.CountIf(Range("A49:A83"), "=" & A) = 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Range("A83").End(xlUp).Offset(1, 0) = A
                Colonne = stcolonne
               Ligne = Range("A83").End(xlUp).Row
               Q = CDbl(Me.Controls("TextBox" & z).Value)
               compteur = 0
                Lig = Range("A36").End(xlUp).Row
               While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
            End If
          End Select
      End Select
    Next z
   Next i

Par exemple si je sélectionne sur l'userform 1 chef de chantier puis 2 ouvriers
le code m'écrit bien chef de chantier et sur la ligne du dessous ouvrier, il impute aussi dans la zone graphique les quantité du chef de chantier sur sa durée d'utilisation, mais oublie totalement les ouvriers, les fournitures et les quantités ; en fait la boucle While ne fonctionne qu'une seule fois et il y a certainement quelque chose que je n'arrive pas a comprendre

J'espère avoir été explicite mais mon projet est une véritable usine à gaz et un peu compliquer comme mon esprit ; j'espère quand même que quelqu'un pourra m'aider car je suis vraiment bloquer

Je mets le code complet du bouton au cas ou le problème vienne de la première partie du code, mais celle-ci fonctionne bien grâce à l'aide précédente du forum

Merci pour votre aide

Cordialement

Didier

**dmoluc** · 20/08/2012, 17h46

oups voilà le code complet

Code :

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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
Private Sub CommandButton10_Click()
 
With Sheets("Programme des travaux")
 
Dim L As Long, C As Long
C = 4
L = Range("A36").End(xlUp).Row
Cells(L, C).Value = TextBox85.Value
Unload UserForm1
With Cells(L, C)
ActiveSheet.Unprotect
If ListBox35 = "M²" Then
.NumberFormat = "#,##0.00 ""M²"""
End If
If ListBox35 = "M³" Then
.NumberFormat = "#,##0.0 ""M³"""
End If
If ListBox35 = "Forfait" Then
.NumberFormat = "#,##0 ""F"""
End If
If ListBox35 = "ML" Then
.NumberFormat = "#,##0.0 ""ML"""
End If
If ListBox35 = "Unitée" Then
.NumberFormat = "#,##0 ""Unt."""
End If
If ListBox35 = "Tonne" Then
.NumberFormat = "#,##0.0 ""T"""
End If
If ListBox35 = "Kg" Then
.NumberFormat = "#,##0 ""Kg"""
End If
If ListBox35 = "Litre" Then
.NumberFormat = "#,##0 ""L"""
End If
End With
Dim W As String
Dim K As String
Dim P As String
Dim Début As Date
Dim J As Double
Dim F As Date
Dim compteur As Double
Dim x As Range
Dim Ligne
Dim Colonne
Début = DTPicker1.Value
Dim Valeur As Double, Durée As Double
 
For i = 6 To 36
 Durée = CDbl(TextBox113.Value)
 Sheets("Feuil1").Range("A17") = Durée
If Range("A" & i) = "" And _
       Range("A" & i - 1) <> "" Then
    J = 0
    J = (Durée * 2)
    Ligne = 5
    Colonne = Application.Match(Me.DTPicker1 * 1, Rows(5))
    If Me.ToggleButton3 = False Then
    ActiveSheet.Cells(Ligne, Colonne).Offset(i - 6, 0) = 1
    End If
 
    If Me.ToggleButton3 = True Then
    ActiveSheet.Cells(Ligne, Colonne).Offset(i - 6, 1).Select
    ActiveCell.Offset(0, -1) = 1
    End If
 
    If Durée = 0.5 Then
        Range("ZZ" & i - 1).End(xlToLeft).Select
Dim rng As Range: Set rng = Selection
 With rng
 .Interior.Color = showcolor
 .Font.Color = showcolor
 End With
        Exit Sub
End If
 
     compteur = 1
 
    While compteur < J
        compteur = compteur + 1
        F = Range("ZZ" & i - 1).End(xlToLeft).Offset(-1 * (i - 6), 0)
        P = Range("ZZ" & i - 1).End(xlToLeft).Offset(-1 * (i - 6), 7)
        Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 1) = 1
        W = WeekdayName(Weekday(F))
        K = WeekdayName(Weekday(F))
 
        If W = "samedi" And compteur < J Then
            Range("zz" & i - 1).End(xlToLeft).Select
            Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
 
 Set rng = Selection
 With rng
 .Interior.Color = showcolor
 .Font.Color = showcolor
 End With
 
            MsgBox "La tâche n'est pas achevée !", vbOKOnly
            If Range("ZZ" & i - 1).End(xlToLeft).Offset(-1 * (i - 6), 5).Interior.Color = 255 Then
            Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 7) = 1
            End If
            Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 5) = 1
        End If
        If W = "samedi" And compteur = J Then
            Range("zz" & i - 1).End(xlToLeft).Select
            Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
            Set rng = Selection
 With rng
 .Interior.Color = showcolor
 .Font.Color = showcolor
 End With
            Exit Sub
        End If
        Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 1).Select
        If ActiveCell.Interior.Color = 255 And compteur < J Then
            Range("zz" & i - 1).End(xlToLeft).Select
            Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
           Set rng = Selection
 With rng
 .Interior.Color = showcolor
 .Font.Color = showcolor
 End With
            MsgBox "La tâche n'est pas achevée !", vbOKOnly
            Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 3) = 1
        End If
         If ActiveCell.Interior.Color = 255 And W = "vendredi" And compteur < J Then
         Range("zz" & i - 1).End(xlToLeft).Select
            Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
            Set rng = Selection
 With rng
 .Interior.Color = showcolor
 .Font.Color = showcolor
 End With
            MsgBox "La tâche n'est pas achevée !", vbOKOnly
            Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 7) = 1
            End If
 
         If ActiveCell.Interior.Color = 255 And W = "jeudi" And compteur < J Then
         Pont = MsgBox("Jeudi Férié ! Voulez-Vous faire le Pont?" & vbYesNo)
         If Pont = vbYes Then
         Range("zz" & i - 1).End(xlToLeft).Select
            Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
            Set rng = Selection
 With rng
 .Interior.Color = showcolor
 .Font.Color = showcolor
 End With
            MsgBox "La tâche n'est pas achevée !", vbOKOnly
            Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 9) = 1
            End If
          If Pont = vbNo Then
         Range("zz" & i - 1).End(xlToLeft).Select
            Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
             Set rng = Selection
 With rng
 .Interior.Color = showcolor
 .Font.Color = showcolor
 End With
            MsgBox "La tâche n'est pas achevée !", vbOKOnly
            Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 3) = 1
            End If
           End If
 
        Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 7).Select
        If ActiveCell.Interior.Color = 255 And K = "mardi" And compteur < J Then
         Pont = MsgBox("Mardi Férié ! Voulez-Vous faire le Pont?" & vbYesNo)
         If Pont = vbYes Then
         Range("zz" & i - 1).End(xlToLeft).Select
            Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
             Set rng = Selection
 With rng
 .Interior.Color = showcolor
 .Font.Color = showcolor
 End With
            MsgBox "La tâche n'est pas achevée !", vbOKOnly
            Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 9) = 1
            End If
          If Pont = vbNo Then
         Range("zz" & i - 1).End(xlToLeft).Select
            Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
            Set rng = Selection
 With rng
 .Interior.Color = showcolor
 .Font.Color = showcolor
 End With
            MsgBox "La tâche n'est pas achevée !", vbOKOnly
            Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 5) = 1
            End If
            End If
 
        If ActiveCell.Interior.Color = 255 And compteur = J Then
        Range("zz" & i - 1).End(xlToLeft).Select
            Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
            Set rng = Selection
 With rng
 .Interior.Color = showcolor
 .Font.Color = showcolor
 End With
            End If
    Wend
    Range("zz" & i - 1).End(xlToLeft).Select
    Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
    Set rng = Selection
 With rng
 .Interior.Color = showcolor
 .Font.Color = showcolor
 End With
End If
Next i
Dim stcolonne As Long
 Dim z As Long
Dim Q As Double
Dim A
Dim Lig As Long
 For i = 11 To 34
 For z = 115 To 137
        Select Case i
        Case 11 To 16
           Select Case z
           Case 115 To 120
 
            A = Me("ListBox" & i).Text
            stcolonne = Colonne
            If Application.CountIf(Range("A39:A45"), "=" & A) <> 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Ligne = Application.Match(A, Columns(1), 0)
               Q = CDbl(Me.Controls("TextBox" & z).Value)
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
               While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
Colonne = stcolonne
                ElseIf Application.CountIf(Range("A39:A45"), "=" & A) = 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Range("A45").End(xlUp).Offset(1, 0) = A
                Ligne = Range("A45").End(xlUp).Row
               Q = CDbl(Me.Controls("TextBox" & z).Value)
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
               While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
            End If
 
          End Select
 
        Case 17 To 26
 
           Select Case z
           Case 121 To 129
            A = Me("ListBox" & i).Text
            Colonne = stcolonne
            If Application.CountIf(Range("A87:A128"), "=" & A) <> 0 And A <> "" And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Ligne = Application.Match(A, Columns(1), 0)
               Q = CDbl(Me.Controls("TextBox" & z).Value)
               Q = Q / TextBox113.Value
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
               While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
                ElseIf Application.CountIf(Range("A87:A128"), "=" & A) = 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Range("A128").End(xlUp).Offset(1, 0) = A
                Colonne = stcolonne
                Ligne = Range("A128").End(xlUp).Row
               Q = CDbl(Me.Controls("TextBox" & z).Value)
               Q = Q / TextBox113.Value
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
               While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
            End If
          End Select
 
                Case 27 To 34
                   Select Case z
           Case 130 To 137
            A = Me("ListBox" & i).Text
            Colonne = stcolonne
              If Application.CountIf(Range("A49:A83"), "=" & A) <> 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Ligne = Application.Match(A, Columns(1), 0)
                Q = CDbl(Me.Controls("TextBox" & z).Value)
                compteur = 0
                Lig = Range("A36").End(xlUp).Row
                While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
                ElseIf Application.CountIf(Range("A49:A83"), "=" & A) = 0 And A <> "" And Me.Controls("TextBox" & z).Value <> "" Then
                Range("A83").End(xlUp).Offset(1, 0) = A
                Colonne = stcolonne
               Ligne = Range("A83").End(xlUp).Row
               Q = CDbl(Me.Controls("TextBox" & z).Value)
               compteur = 0
                Lig = Range("A36").End(xlUp).Row
               While Cells(Lig, Colonne) = 1 And compteur <= CDbl(TextBox113.Value)
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
Wend
            End If
          End Select
      End Select
    Next z
   Next i
 
 
 
 
End With
Exit Sub
ETIQUETTE:
 
End Sub

**dmoluc** · 20/08/2012, 18h47

Je ne sais pas si c'est important mais je viens de modifier la boucle While pour qu'elle tienne compte des vide de la zone graphique (jours fériés et weekend)
mais je n'arrive toujours pas à faire exécuter cette boucle autant de fois que j'écrit le texte des listbox sur la feuille ; elle tourne comme il faut une fois puis s'arrête

Je ne sais vraiment pas comment m'y prendre et est besoin de votre aide, merci d'avance

cordialemnt

**Bear the french** · 20/08/2012, 19h08

Bonjour,

Ton code est long, du coup l'erreur est compliquée à chercher sans ton fichier.

A ta place, j’insérerai des MsgBox pour voir dans quelle boucle la macro rentre et pour voir comment évolue mes variables.

Si le MsgBox est ok, je le descend plus bas pour faire d'autres tests... etc

Bertrand

**dmoluc** · 20/08/2012, 19h21

Bonjour Bertrand

Je ne crois pas qu'il y est une erreur dans le code mais plutôt que la boucle While est mal faite, car les boucles for fonctionnent bien, la boucle while fonctionne une fois comme il faut en traitant la première listbox inscrite sur la feuille et néglige les suivantes

si la boucle while n'en fait plus a sa tête le classeur est terminé ; ça fait plus de deux mois que je suis dessus et je bloque sur la dernière ligne droite, c'est bête

Merci encore pour ton aide

voici le lien du fichier complet :

http://cjoint.com/?3HuslJiXhXc
Le code se trouve : UserForm5, page "Déboursé pour la tâche", bouton "Renseigner le planing"

pour appeler l'userForm, feuille "programme des travaux", bouton "Rendement et sous détail"

A+

**Bear the french** · 20/08/2012, 20h13

"appeler l'userForm, feuille "programme des travaux", bouton "Rendement et sous détail"" *--> cela génère une erreur.

J'ai deux conseils pour ton avenir de programmeur (et surtout vu l'ambition de ton projet et son grand nombre de lignes de code) :

1. commentes ton code (pour les autres mais surtout pour toi dans quelques temps...)
2. indentes ton code - c'est le minimum vital pour vérifier l'imbrication de tes boucles. Indenter, c'est décaler les paragraphes avec la tabulation, pour créer une hiérarchie et une paternité entre les éléments.

Une fois indenté, ça donne ça :

Code :

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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
Private Sub CommandButton1_Click()
On Error GoTo ETIQUETTE
ActiveSheet.Unprotect
Dim W As String
Dim K As String
Dim P As String
Dim Début As Date
Dim J As Double
Dim F As Date
Dim compteur As Double
Dim x As Range
Dim Ligne
Dim Colonne
Début = DTPicker1.Value
Dim Valeur As Double
 
For i = 6 To 36
    Durée = Range("E" & i - 1).Value
    Sheets("Feuil1").Range("A17") = Durée.Value
    If Range("D" & i) = "" And _
           Range("D" & i - 1) <> "" _
           Or Application.WorksheetFunction.Sum(Range("G" & i - 1 & ":Zz" & i - 1)) = 0 _
           And Application.WorksheetFunction.Sum(Range("G" & i & ":Zz" & i)) > 0 Then
        J = 0
        J = (Durée.Value * 2)
        Ligne = 5
        Colonne = Application.Match(Me.DTPicker1 * 1, Rows(5))
        If Me.ToggleButton1 = False Then
            ActiveSheet.Cells(Ligne, Colonne).Offset(i - 6, 0) = 1
        End If
        If Me.ToggleButton1 = True Then
            ActiveSheet.Cells(Ligne, Colonne).Offset(i - 6, 1).Select
            ActiveCell.Offset(0, -1) = 1
        End If
 
        If Durée = 0.5 Then
            Range("ZZ" & i - 1).End(xlToLeft).Select
            Dim rng As Range: Set rng = Selection
            With rng
                .Interior.Color = showcolor
                .Font.Color = showcolor
            End With
            Exit Sub
        End If
 
        If i = 6 Or Durée <= 2 Then
            compteur = 1
        End If
 
        If i > 6 And Durée > 2 And Me.ToggleButton1 = True Or Me.ToggleButton1 = False Then
            compteur = 2
        End If
 
        If Me.ToggleButton1 = True And Durée <= 2 Then
            compteur = 1
        End If
 
        While compteur < J
            compteur = compteur + 1
            F = Range("ZZ" & i - 1).End(xlToLeft).Offset(-1 * (i - 6), 0)
            P = Range("ZZ" & i - 1).End(xlToLeft).Offset(-1 * (i - 6), 7)
            Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 1) = 1
            W = WeekdayName(Weekday(F))
            K = WeekdayName(Weekday(F))
 
            If W = "samedi" And compteur < J Then
                Range("zz" & i - 1).End(xlToLeft).Select
                Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
                Set rng = Selection
                With rng
                    .Interior.Color = showcolor
                    .Font.Color = showcolor
                End With
                MsgBox "La tâche n'est pas achevée !", vbOKOnly
                If Range("ZZ" & i - 1).End(xlToLeft).Offset(-1 * (i - 6), 5).Interior.Color = 255 Then
                    Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 7) = 1
                End If
                Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 5) = 1
            End If
 
            If W = "samedi" And compteur = J Then
                Range("zz" & i - 1).End(xlToLeft).Select
                Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
                Set rng = Selection
                With rng
                    .Interior.Color = showcolor
                    .Font.Color = showcolor
                End With
                Exit Sub
            End If
 
            Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 1).Select
 
            If ActiveCell.Interior.Color = 255 And compteur < J Then
                Range("zz" & i - 1).End(xlToLeft).Select
                Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
                Set rng = Selection
                With rng
                    .Interior.Color = showcolor
                    .Font.Color = showcolor
                End With
                MsgBox "La tâche n'est pas achevée !", vbOKOnly
                Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 3) = 1
            End If
 
            If ActiveCell.Interior.Color = 255 And W = "vendredi" And compteur < J Then
                Range("zz" & i - 1).End(xlToLeft).Select
                Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
                Set rng = Selection
                With rng
                    .Interior.Color = showcolor
                    .Font.Color = showcolor
                End With
                MsgBox "La tâche n'est pas achevée !", vbOKOnly
                Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 7) = 1
            End If
 
            If ActiveCell.Interior.Color = 255 And W = "jeudi" And compteur < J Then
                Pont = MsgBox("Jeudi Férié ! Voulez-Vous faire le Pont?" & vbYesNo)
                If Pont = vbYes Then
                    Range("zz" & i - 1).End(xlToLeft).Select
                    Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
                    Set rng = Selection
                    With rng
                        .Interior.Color = showcolor
                        .Font.Color = showcolor
                    End With
                    MsgBox "La tâche n'est pas achevée !", vbOKOnly
                    Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 9) = 1
                End If
                If Pont = vbNo Then
                    Range("zz" & i - 1).End(xlToLeft).Select
                    Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
                    Set rng = Selection
                    With rng
                        .Interior.Color = showcolor
                        .Font.Color = showcolor
                    End With
                    MsgBox "La tâche n'est pas achevée !", vbOKOnly
                    Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 3) = 1
                End If
            End If
 
            Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 7).Select
            If ActiveCell.Interior.Color = 255 And K = "mardi" And compteur < J Then
                Pont = MsgBox("Mardi Férié ! Voulez-Vous faire le Pont?" & vbYesNo)
                If Pont = vbYes Then
                    Range("zz" & i - 1).End(xlToLeft).Select
                    Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
                    Set rng = Selection
                    With rng
                        .Interior.Color = showcolor
                        .Font.Color = showcolor
                    End With
                    MsgBox "La tâche n'est pas achevée !", vbOKOnly
                    Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 9) = 1
                End If
                If Pont = vbNo Then
                    Range("zz" & i - 1).End(xlToLeft).Select
                    Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
                    Set rng = Selection
                    With rng
                        .Interior.Color = showcolor
                        .Font.Color = showcolor
                    End With
                    MsgBox "La tâche n'est pas achevée !", vbOKOnly
                    Range("ZZ" & i - 1).End(xlToLeft).Offset(0, 5) = 1
                End If
            End If
 
            If ActiveCell.Interior.Color = 255 And compteur = J Then
                Range("zz" & i - 1).End(xlToLeft).Select
                Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
                Set rng = Selection
                With rng
                    .Interior.Color = showcolor
                    .Font.Color = showcolor
                End With
            End If
            MsgBox "pour voir si compteur=(" & compteur & ") est encore < à J=(" & J & ")"
        Wend
        Range("zz" & i - 1).End(xlToLeft).Select
        Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
        Set rng = Selection
        With rng
            .Interior.Color = showcolor
            .Font.Color = showcolor
        End With
    End If
Next i
 
 
 
 
Unload UserForm1
Exit Sub
ETIQUETTE: Unload UserForm1
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Comme je ne parviens pas à lancer l'userform sans créer d'erreur, je te propose d'insérer une ligne de code juste avant "Wend" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MsgBox "pour voir si compteur=(" & compteur & ") est encore < à J=(" & J & ")"

Et dis nous ce que cela donne.

Bertrand

Multiples boucles imbriquées, suis-je sur la bonne voie ? [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager