Macro qui ne fonctionne que si j'insère un point d'arrêt

**nashifr** · 12/03/2014, 16h00

Bonjour
j'essaie de développer une macro qui génère plusieurs images à partir d'un modèle situé dans une zone de cellule et constitué de différents contrôles (essentiellement des labels).
la macro generation_images utilise deux sous macros
images_CSN (i) qui met en forme les contrôles et
export (i) qui exporte l'image en gif
ces sous macros sont réitérées dans une boucle qui fait évoluer les valeurs des contrôles.

mon problème est le suivant, lorsque je l’exécute en mode pas à pas ou que j'insère un "STOP" entre les deux macros cela fonctionne.
dés que je l'enlève, il n'y a pas de message d'erreur, mais les images générées sont fausses, comme si le temps de mise a jour de mes valeurs de contrôle était trop important. le fichier est joint, ci dessous mon code.
merci de votre aide.

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
 
Dim donneetab01(1 To 14, 1 To 21) As Variant
Dim Maj As Date
 
Sub generation_images()
 
Dim i As Integer, j As Integer
 
'creation du tableau de données
    For i = 1 To UBound(donneetab01, 1) 'boucle sur la 1ere dimension
        For j = 1 To UBound(donneetab01, 2) 'boucle sur la 2eme dimension
            'Alimente les éléments du tableaux
            donneetab01(i, j) = Sheets("DONNEESCARTES").Cells(i + 1, j + 1).Value
        Next j
    Next i
Maj = Sheets("DONNEESCARTES").Cells(17, 3).Value
 
Workbooks("CSNs.xls").Worksheets("IMAGE").Activate
 
 
For i = 1 To 3 'UBound(donneetab01, 1)
images_CSN (i)
'gestion date de mise à jour
Workbooks("CSNs.xls").Worksheets("IMAGE").Label_update02.Caption = Format(Maj, "dd/mm/yyyy")
 
'Stop
 
export (i)
 
Next i
 
End Sub
 
 
Sub images_CSN(m As Integer)
 
Dim largeurmax As Currency
Dim inspection As Currency
Dim objectif As Currency
Dim eligible As Currency
Dim objectifglissant As Currency
Dim rate_HRS As Currency
Dim rate_nonHRS As Currency
Dim Ratevalidation As Currency
Dim Rateprocessor As Currency
 
 
 
'gestion des barres cadre inspections
largeurmax = 295
inspection = CCur(donneetab01(m, 4))
objectif = CCur(donneetab01(m, 2))
eligible = CCur(donneetab01(m, 5))
objectifglissant = CCur(donneetab01(m, 3))
 
 
With Workbooks("CSNs.xls").Worksheets("IMAGE")
.Label_val_insp.Caption = inspection
.Label_nb_eligibles.Caption = eligible
.Label_val_objectif.Caption = objectif
.Label_nb_obj_glissant.Caption = objectifglissant
 
 
If eligible = 0 And objectif = 0 Then
Else
        If eligible < objectif Then
        .Label_barre_objectif.Width = largeurmax
        .Label_val_objectif.Left = largeurmax + 56
        .Label_nb_eligibles.Left = 56 + eligible * largeurmax / objectif
        .Image_ship_eligibles.Left = .Label_nb_eligibles.Left - .Image_ship_eligibles.Width
        .Label_nb_obj_glissant.Left = 56 + objectifglissant * largeurmax / objectif
        .Image_ship_obj_glissant.Left = .Label_nb_obj_glissant.Left - .Image_ship_obj_glissant.Width
                If eligible * largeurmax / objectif - .Image_ship_eligibles.Width <= 0 Then
                .Label_barre_eligibles.Width = 0
                Else
                .Label_barre_eligibles.Width = eligible * largeurmax / objectif - .Image_ship_eligibles.Width
                End If
        .Label_barre_eligibles.Left = 56
 
                If objectifglissant * largeurmax / objectif - .Image_ship_obj_glissant.Width <= 0 Then
                .Label_barre_obj_glissant.Width = 0
                Else
                .Label_barre_obj_glissant.Width = objectifglissant * largeurmax / objectif - .Image_ship_obj_glissant.Width
                End If
        .Label_barre_obj_glissant.Left = 56
 
                If inspection < objectif Then
                .Label_barre_insp.Width = inspection * .Label_barre_objectif.Width / objectif
                Else
                .Label_barre_insp.Width = inspection * (.Label_nb_eligibles.Left - 56) / eligible
                End If
        .Label_val_insp.Left = 56 + .Label_barre_insp.Width
 
        Else
        .Label_nb_eligibles.Left = 56 + largeurmax
        .Image_ship_eligibles.Left = .Label_nb_eligibles.Left - .Image_ship_eligibles.Width
        .Label_barre_eligibles.Width = .Label_nb_eligibles.Left - .Image_ship_eligibles.Width
        .Label_barre_eligibles.Left = 56
        .Label_barre_objectif.Width = largeurmax * objectif / eligible
        .Label_val_objectif.Left = 56 + largeurmax * objectif / eligible
        .Label_objectif_01.Left = .Label_val_objectif.Left - .Label_objectif_01.Width
 
        .Label_nb_obj_glissant.Left = largeurmax * objectifglissant / eligible + 56
        .Image_ship_obj_glissant.Left = .Label_nb_obj_glissant.Left - .Image_ship_obj_glissant.Width
        .Label_barre_obj_glissant.Left = 56
 
                If .Image_ship_obj_glissant.Left - 56 > 0 Then
                .Label_barre_obj_glissant.Width = .Image_ship_obj_glissant.Left - 56
                Else
                .Label_barre_obj_glissant.Width = 0
                End If
 
                If inspection < objectif Then
                .Label_barre_insp.Width = inspection * .Label_barre_objectif.Width / objectif
                Else
                .Label_barre_insp.Width = inspection * (.Label_nb_eligibles.Left - 56) / eligible
                End If
 
        .Label_val_insp.Left = 42 + .Label_barre_insp.Width
        .Label_objectif_01.Left = .Label_val_objectif.Left - .Label_objectif_01.Width
 
        End If
End If
 
'gestion des couleur cadre inspections
 
If inspection >= objectifglissant + 0.01 * objectif Then
.Label_indicateur_insp.ForeColor = &HC000&
.Label_barre_insp.BackColor = &HC000&
.Label_val_insp.ForeColor = &HC000&
.Label_insp_01.ForeColor = &HC000&
Else
        If inspection >= objectifglissant Then
        .Label_indicateur_insp.ForeColor = &H80FF&
        .Label_barre_insp.BackColor = &H80FF&
        .Label_val_insp.ForeColor = &H80FF&
        .Label_insp_01.ForeColor = &H80FF&
        Else
        .Label_indicateur_insp.ForeColor = &HFF&
        .Label_barre_insp.BackColor = &HFF&
        .Label_val_insp.ForeColor = &HFF&
        .Label_insp_01.ForeColor = &HFF&
        End If
End If
 
 
 
' gestion des valeurs cadre Miss & des couleurs
 
.Label_nbHRS.Caption = "(" & CCur(donneetab01(m, 8)) & "/" & CCur(donneetab01(m, 7)) & ")"
.Label_rateHRS.Caption = CCur(donneetab01(m, 9)) & " %"
.Label_nbnonHRS.Caption = "(" & CCur(donneetab01(m, 11)) & "/" & CCur(donneetab01(m, 10)) & ")"
.Label_ratenonHRS.Caption = CCur(donneetab01(m, 12)) & " %"
 
rate_HRS = CCur(donneetab01(m, 9))
rate_nonHRS = CCur(donneetab01(m, 12))
 
If rate_HRS <= 4 Then
.Label_nbHRS.ForeColor = &HC000&
.Label_rateHRS.ForeColor = &HC000&
.Label_HRS.ForeColor = &HC000&
Else
        If rate_HRS <= 5 Then
        .Label_nbHRS.ForeColor = &H80FF&
        .Label_rateHRS.ForeColor = &H80FF&
        .Label_HRS.ForeColor = &H80FF&
        Else
        .Label_nbHRS.ForeColor = &HFF&
        .Label_rateHRS.ForeColor = &HFF&
        .Label_HRS.ForeColor = &HFF&
        End If
End If
 
If rate_nonHRS <= 8 Then
.Label_nbnonHRS.ForeColor = &HC000&
.Label_ratenonHRS.ForeColor = &HC000&
.Label_nonHRS.ForeColor = &HC000&
Else
        If rate_nonHRS <= 10 Then
        .Label_nbnonHRS.ForeColor = &H80FF&
        .Label_ratenonHRS.ForeColor = &H80FF&
        .Label_nonHRS.ForeColor = &H80FF&
        Else
        .Label_nbnonHRS.ForeColor = &HFF&
        .Label_ratenonHRS.ForeColor = &HFF&
        .Label_nonHRS.ForeColor = &HFF&
        End If
End If
 
If rate_HRS > 5 Or rate_nonHRS > 10 Then
.Label_indicateur_miss.ForeColor = &HFF&
Else
        If rate_HRS > 0.04 Or rate_nonHRS > 0.08 Then
        .Label_indicateur_miss.ForeColor.ForeColor = &H80FF&
        Else
        .Label_indicateur_miss.ForeColor = &HC000&
        End If
End If
 
 
 
' gestion des valeurs cadre validation & des couleurs
 
Ratevalidation = CCur(donneetab01(m, 16))
.Label_rate72h.Caption = Ratevalidation & " %"
 
If Ratevalidation = 100 Then
.Label_rate72h.ForeColor = &HC000&
.Label_indicateur_72h.ForeColor = &HC000&
Else
        If Ratevalidation > 90 Then
        .Label_rate72h.ForeColor = &H80FF&
        .Label_indicateur_72h.ForeColor = &H80FF&
        Else
        .Label_rate72h.ForeColor = &HFF&
        .Label_indicateur_72h.ForeColor = &HFF&
        End If
End If
 
 
' gestion des valeurs cadre quality & des couleurs
 
Rateprocessor = CCur(donneetab01(m, 14))
.Label_rateQuality.Caption = Rateprocessor & " %"
 
If Rateprocessor >= 85 Then
.Label_rateQuality.ForeColor = &HC000&
.Label_process.ForeColor = &HC000&
.Label_indicateur_quality.ForeColor = &HC000&
Else
        If Rateprocessor > 75 Then
        .Label_rateQuality.ForeColor = &H80FF&
        .Label_process.ForeColor = &H80FF&
        .Label_indicateur_quality.ForeColor = &H80FF&
        Else
        .Label_rateQuality.ForeColor = &HFF&
        .Label_process.ForeColor = &HFF&
        .Label_indicateur_quality.ForeColor = &HFF&
        End If
End If
 
 
'gestion date de mise à jour
.Label_update02.Caption = Format(Maj, "dd/mm/yyyy")
 
End With
 
End Sub
 
 
Sub export(m As Integer)
' exportation des images
 
Dim f As Worksheet
Dim champExport As Range
 
Set f = Workbooks("CSNs.xls").Worksheets("IMAGE")
f.Range("A1:f19").Select
Set champExport = Selection
champExport.CopyPicture
f.ChartObjects.Add(0, 300, champExport.Width, champExport.Height).Chart.Paste
sBook = ActiveWorkbook.Path
sPath = sBook & "\" & donneetab01(m, 17) & "_ETAT.gif"
f.ChartObjects(1).Chart.export Filename:=sPath, FilterName:="GIF"
f.ChartObjects(1).Delete
Range("a1").Select
 
End Sub

Macro qui ne fonctionne que si j'insère un point d'arrêt [XL-2003]

Macros et VBA Excel

Mode arborescent

Discussions similaires

Partager

Partager