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

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

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, 16h46

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, 17h47

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, 18h08

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, 18h21

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, 19h13

"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

**dmoluc** · 20/08/2012, 20h51

Compteur = 1, J = 6
il passe ensuite à 2 puis à 3 et bloque
Donc la boucle ne finis pas de s'exécuter, pourtant jusqu'à présent elle s'exécuter complètement une fois ; je n'y comprend rien !
Bisard que tu n'arrives pas à lancer l'UserForm chez moi ça fonctionne parfaitement ; ça risque de me donner quelque soucis si ça ne fonctionne pas sur tout les ordinateurs

Je sais bien que le code est un code de débutant et plein de petite erreur et à l'avenir je suivrais ton conseil de bien le présenter et de l'annoter car il est possible que dans quelques temps je ne sache plus ce que j'ai écrit de plus que c'est vrai que cela ressemble à une usine à gaz : (

C'est mon deuxième classeur mais le premier était moins difficile car c'était simplement des calculs dont la plupart avec des formules excel. Ce coup ci j'essais de faire quelque chose de simple à utiliser, plus élaborer qu'un simple diagramme de gant fait avec excel sans pour autant vouloir remplacer MS Project qui est d’ailleurs trop compliquer pour les gens qui vont utiliser le tableau.

Si ça peu servir à quelqu'un je joint mon premier programme qui fonctionne et ne demande qu'à être critiquer. C'est de la Topographie et bien sur il faut avoir quelques notions pour remplir les tableaux d'autant plus que je ne me suis pas encore lancé dans les fichier explicatifs

http://cjoint.com/?3Huu4eoGTvN

Pour en revenir à la boucle, je voudrais bien savoir pourquoi elle ne s'exécute qu'une fois ; au début j'avais fait une boucle avec Do Unthil et Loop et ça ne tourner pas du tout, pourtant je n'ai pas changé les conditions.

Dur dur, je suis loin d'être un programmeur

Encore merci pour ton aide

A +

**Nako_lito** · 20/08/2012, 21h19

Comme le dit Bear The French, il faut abuser des infos pendant le debuggage.
mets des msgbox partout, verifie chaque valeurs a chaque etape pour etre certain que la donnee entree est correcte. Mets d'autres valeurs aussi pour t'assurer que c'est pas juste un coup de bol.

Ca va etre long et fastidieux, mais t'as pas le choix. Bienvenue dans le monde de la prog ^^

Envoyé par dmoluc

Pour en revenir à la boucle, je voudrais bien savoir pourquoi elle ne s'exécute qu'une fois ; au début j'avais fait une boucle avec Do Unthil et Loop et ça ne tourner pas du tout, pourtant je n'ai pas changé les conditions.

Une des premieres choses qu'on apprends aux apprentis programmeur c'est que chaque boucle a son utilite et il n'est pas dit qu'un cycle puisse s'executer avec tous les types de boucle.

Ensuite, si la boucle ne boucle qu'une fois, c'est que la condition de sortie est verifiee, donc tu dois mettre un msgbox pour savoir ce que teste la boucle avant de quitter ou refaire son cycle. tu auras ta reponse

Autre point :

Code :

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

1
2
3
4
5
6
Range("zz" & i - 1).End(xlToLeft).Select
                    Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
                    Set rng = Selection
                    With rng
                        .Interior.Color = showcolor
                        .Font.Color = showcolor

Attention, tu emplois du code relatif, prefere l'absolu avec des references claire et precise.
Vers quoi pointe "Range(ActiveCell)" ? Sur quelle feuille ? Sur quelle cellule ?
Ensuite attention ou tu mets tes "with".

Dernier point, au lieu de selectionner une zone et ensuite travailler sur cette selection, travaille direct sur cette selection.

Donc il vaudrait mieux mettre qqc comme :

Code :

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

1
2
3
with ThisWorkBook.WorkSheet(x).Cells(x,y)
.Interior.Color = showcolor
.Font.Color = showcolor

pour le petit code que j'ai pris.

Petite erreur que j'ai noté également, tu selectionne la zone a gauche de zz, mais ensuite tu selectionne une autre zone sans rien faire avec la precedente.

tu devrais te creer une fonction ou deux qui te renvoient les dernier index ligne et collone de ta feuille.

**dmoluc** · 20/08/2012, 21h53

merci pour tout ces conseils dont j'ai grand besoin. Je suis totalement autodidacte en informatique et aussi très entêter, parfois ça m'aide, d'autre fois je fais fausse route, mais grâce au conseils et au exemples que j'ai pu trouver sur le forum je pense que petit à petit je progresse un peu.

Demain matin je vais essayer de trouver l'erreur, si la syntaxe est correcte je devrais bien arriver à trouver ma maladresse à moins qu'il faille utiliser un autre type de boucle (c'est un peu comme la déclaration des variables ; j'y vais un peu au pif

Bonne soirée à tous, de toute façon je vous tiendrais informé de l'évolution de mes recherches

A+

**Philippe Tulliez** · 20/08/2012, 22h02

Bonjour,
Pour le debug de ta boucle, j'aurais plutôt tendance à utiliser le pas à pas.
Tu places d'abord un arrêt au début de ta boucle et ensuite tu lances ton programme.
Pour mettre l'arrêt sur une ligne de programme, tu sélectionnes la ligne en question et tu appuies sur la touche F9
Il va donc s'arrêter à cet endroit et ensuite tu appuies sur F8 pour avancer "pas à pas". Tu pourras ainsi voir à quel moment le problème se passe.
Tu peux aussi ajouter un espion ou plusieurs espions pour visualiser la ou les variables concernées. Sélection de la variable ensuite Debogage/Ajouter un espion.
Ton code ne fonctionne pas non plus chez moi, tu as référencé 3 objets que je n'ai pas ou qui ne sont pas accessibles.

**dmoluc** · 21/08/2012, 10h05

Bonjour à tous

J'ai suivi les instructions de Philippe et voilà ce qui ce passe avec la première boucle qui traite la plage personnel :
La boucle fonctionne à merveille pour la première listBox "personnel" mais quand les conditions sont fausses au lieu de passer à la boucle suivante qui traite les fournitures, le programme va direct sur exit sub
Il faudrait que je trouve un moyen pour que la boucle se réinitialise et se répète tant qu'il y a des listbox personnel pleines, puis passe à fourniture et enfin fasse de même pour le matériel.
le code lancer aussi l'UserForm1, et là c'est un mystère car il n'aurait du se lancer que si la plage D6

36 se modifiée, ce qui n'est pas le cas dans le code, du coup j'ai mis l'userform1 avec un bouton pour être sur que ça ne perturbe rien.

J'aurai bien besoin d'une syntaxe pour permettre la répétition de ces boucles ; je suis en manque d'idées...

J'ai aussi vérifier si la feuille fonctionnée sur un autre poste et même avec la même version d'excel ça ne marche pas, encore un autre grand mystère

Encore un grand merci pour l'aide que vous m'apportez

cordialement

Diider

j'ai rajouté une condition de "sécurité" dans la boucle

Code :

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

1
2
3
4
5
6
7
8
9
10
 While Cells(Lig, Colonne) = 1 Or compteur <= CDbl(TextBox113.Value)
If Cells(Lig, Colonne) = "" And compteur <= CDbl(TextBox113.Value) And B <> A Then
B = A
Colonne = Colonne + 2
Else
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
End If
Wend

Le code se répète bien mais au lieu de passer en revue chaque chapitre il va a la fin puis repart au début et ça ne peut pas fonctionner car A ne change plus, donc finalement le problème ne vient peu être pas des boucles While, mais des boucles For...
Un peu trop compliquer pour moi

Code :

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

 A = Me("ListBox" & i).Text

**Godzestla** · 21/08/2012, 10h19

Le code se répète bien mais au lieu de passer en revue chaque chapitre il va a la fin puis repart au début et ça ne peut pas fonctionner car A ne change plus, donc finalement le problème ne vient peu être pas des boucles While, mais des boucles For...
Un peu trop compliquer pour moi

Bonjour,

pour paraphraser les membres de ce forum qui t'ont répondu, je pense que vu la complexité de ce que tu veux faire tu a mis la charrue avant les boeufs.

Une bon problème doit être analysé et pouvoir être formulé clairement AVANT d'écrire la première ligne de programmation, et 3 fois plus si on est débutant autodidacte en codage.

Moi je te conseille d'écrire ou construire ton algorithme ou flowchart avant toute chose, de le relire, modifier, adapter, contrôler, tester à la main et puis quand enfin tu seras satisfait de ce que cela donne, tu commenceras à être mûr pour passer au codage.

Un bon codage complexe et fiable n'est JAMAIS réalisable sans une bonne réflection.

**dmoluc** · 21/08/2012, 16h28

Voici mon code corriger, je l'ai simplifié et ça fonctionne, il ne me reste plus qu'à trouver pourquoi le programme ne fonctionne que chez moi.

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
Dim stcolonne As Long
 Dim z As Long
Dim Q As Double
Dim A
Dim Lig As Long
stcolonne = Colonne
For i = 11 To 16
z = 115
Colonne = stcolonne
               A = Me("ListBox" & i).Text
            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 Or compteur <= CDbl(TextBox113.Value) And Colonne < 110
If Cells(Lig, Colonne) = "" And compteur <= CDbl(TextBox113.Value) Then
Colonne = Colonne + 2
ElseIf Colonne < 110 Then
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
End If
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 Or compteur <= CDbl(TextBox113.Value)
If Cells(Lig, Colonne) = "" And compteur <= CDbl(TextBox113.Value) And Colonne < 110 Then
Colonne = Colonne + 2
ElseIf Colonne < 110 Then
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
End If
Wend
End If
        z = z + 1
        Next i
 
          For i = 17 To 25
          z = 121
 
Colonne = stcolonne
            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 Or compteur <= CDbl(TextBox113.Value)
If Cells(Lig, Colonne) = "" And compteur <= CDbl(TextBox113.Value) And Colonne < 110 Then
Colonne = Colonne + 2
ElseIf Colonne < 110 Then
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
End If
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 Or compteur <= CDbl(TextBox113.Value)
If Cells(Lig, Colonne) = "" And compteur <= CDbl(TextBox113.Value) And Colonne < 110 Then
Colonne = Colonne + 2
ElseIf Colonne < 110 Then
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
End If
Wend
            End If
       z = z + 1
     Next i
 
        For i = 27 To 34
       z = 130
 
Colonne = stcolonne
            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 Or compteur <= CDbl(TextBox113.Value)
If Cells(Lig, Colonne) = "" And compteur <= CDbl(TextBox113.Value) And Colonne < 110 Then
Colonne = Colonne + 2
ElseIf Colonne < 110 Then
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
End If
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 Or compteur <= CDbl(TextBox113.Value)
If Cells(Lig, Colonne) = "" And compteur <= CDbl(TextBox113.Value) And Colonne < 110 Then
Colonne = Colonne + 2
ElseIf Colonne < 110 Then
Cells(Ligne, Colonne).Value = Q
compteur = compteur + 1
Colonne = Colonne + 2
End If
Wend
 
End If
 
z = z + 1
Next i

**Philippe Tulliez** · 21/08/2012, 16h56

Bonjour,

Envoyé par dmoluc

Voici mon code corriger, je l'ai simplifié et ça fonctionne, il ne me reste plus qu'à trouver pourquoi le programme ne fonctionne que chez moi.

Parce-que tu utilises des références à des librairies d'objets non présentes chez les autres ou dont les versions seraient différentes. Comme par exemple Microsoft DataList Controls 6.0 (OLEDB).
Ajouter des objets ActiveX et autres peut te réserver de belles surprises et requiert une certaine expérience. Je ne peux que te suggérer d'essayer autant que possible de rester dans le standard pour débuter surtout si tu comptes distribuer ton application.

**dmoluc** · 21/08/2012, 17h05

Les seuls contrôle que j'ai ajouté sont les DTPicker qui n'étaient pas présent par défaut. Si j'ai ajouté autre chose c'est malencontreusement sans y prêter attention. J'ai plus qu'a trouver quoi...

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

Macros et VBA Excel

Discussions similaires

Partager

Partager