Erreur de macro sur création de PDF

**Afosty** · 04/12/2018, 14h56

Bonjour à tous,

Vous trouverez ci-joint une copie du code.

L'objectif de ce fichier et de prendre un onglet modèle (RESTIT OVH) et de le copier un nombre de fois équivalent a une liste prédéfinie.

Lors de cette copie, j'ai l'impression qu'en fonction de la charge de travail, Excel a du mal a me donner un rendu final satisfaisant :

- il arrive que lors de ma conversion en PDF, certaines police d'écriture saute et donne un rendu dans un style Hiéroglyphique... (Pas de capture sous la main mais vous voyez l'idée)
- il arrive également de ne pas avoir tous les tableaux.

Je joint une capture écran du Userform pour mieux appréhender le code.

Code 1 : Celui du userform.

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
 
Private Sub CommandButton1_Click()
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
If OptionButton1 = True Then
 
    Sheets("RESTIT OVH").Select
    ActiveWindow.View = xlNormalView
    ActiveSheet.PageSetup.PrintArea = "B9"
    ActiveSheet.Outline.ShowLevels RowLevels:=2
 
Call CopieSynth
End If
 
 
 
If OptionButton2 = True Then
 
    Sheets("RESTIT OVH").Select
    ActiveWindow.View = xlNormalView
    ActiveSheet.PageSetup.PrintArea = "B9"
    ActiveSheet.Outline.ShowLevels RowLevels:=3
 
Call Copiedetl
End If
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
End Sub

Code 2 celui du process en lui même (Utiliser une fois pour une version détaillée et une synthétique) :

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
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
 
Sub CopieSynth()
 
Dim Derlig As Byte
Dim Prelig As Byte
Dim Colonne As Byte
Dim colonneOVH As Byte
Dim Resp As String
Dim RespRestit As String
Dim nomonglet As String
Dim borne1 As String
Dim borne2 As String
Dim WB1 As Workbook
Dim MyArray() As String
Dim y As Integer, z As Byte
Dim repertoire As String
Dim Wbname As String
Dim Nbligne1 As Byte
Dim Nbligne2 As Byte
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
 
Wbname = ThisWorkbook.Name
repertoire = ActiveWorkbook.Path
 
' Process de localisation de la liste
Sheets("Impression").Select
colonneOVH = Application.Match("RESTIT OVH", Range("A2:Z2"), 0)
Colonne = Application.Match(Userform1.Bookliste.Value, Range("A2:Z2"), 0)
Range("A1").End(xlDown).Offset(0, Colonne - 1).End(xlUp).Select
Derlig = ActiveCell.Row
 
Range("A1").End(xlDown).Offset(0, Colonne - 1).End(xlUp).Select
ActiveCell.End(xlUp).Offset(2, 0).Select
Prelig = ActiveCell.Row
 
RespRestit = Cells(Prelig - 1, Colonne).Value
Sheets("Restit ovh").Select
Range("B9").Value = RespRestit
Range("B142").Value = RespRestit
 
Nbligne2 = (Derlig * 4) - (Premlig * 4)
Nbligne1 = 0
 
' Process de recopie de l'onglet source (VERSION SYNTHETIQUE)
For i = Prelig To Derlig
 
   Sheets("Impression").Select
   Cells(i, Colonne).Select
   Resp = ActiveCell.Value
   Cells(i, colonneOVH).Select
   nomonglet = ActiveCell.Value
   Sheets("RESTIT OVH").Select
   Sheets("RESTIT OVH").Copy Before:=Sheets("-")
   ActiveSheet.Name = nomonglet
   Range("B9").Value = Resp
   Range("B142").Value = Resp
 
Nbligne1 = Nbligne1 + 1
Userform1.ProgressBar1.Value = (Nbligne1 / Nbligne2) * 100
 
Next
 
'Process de création du PDF (VERSION SYNTHETIQUE)
 
borne1 = Sheets("- ").Index + 1
borne2 = Sheets("-").Index - 1
 
For i = borne1 + 2 To borne2
      Worksheets(i).Select
ActiveSheet.PageSetup.PrintArea = "$B$9:$V$139,$B$142:$I$272"
 
If Range("AA1").Value = 0 Then
ActiveSheet.PageSetup.PrintArea = "$B$9:$V$139"
End If
 
 With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.196850393700787)
        .RightMargin = Application.InchesToPoints(0.196850393700787)
        .TopMargin = Application.InchesToPoints(0.15748031496063)
        .BottomMargin = Application.InchesToPoints(0.15748031496063)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 63
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
 
Nbligne1 = Nbligne1 + 1
Userform1.ProgressBar1.Value = (Nbligne1 / Nbligne2) * 100
 
Next
 
Sheets("Restit OVH").Select
ActiveSheet.PageSetup.PrintArea = "$B$9:$V$139,$B$142:$I$272"
 
 With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.196850393700787)
        .RightMargin = Application.InchesToPoints(0.196850393700787)
        .TopMargin = Application.InchesToPoints(0.15748031496063)
        .BottomMargin = Application.InchesToPoints(0.15748031496063)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 63
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
 
Set WB1 = ThisWorkbook
'
    For y = borne1 To borne2
        ReDim Preserve MyArray(z)
        MyArray(z) = Sheets(y).Name
           z = z + 1
 
Nbligne1 = Nbligne1 + 1
Userform1.ProgressBar1.Value = (Nbligne1 / Nbligne2) * 100
    Next
            WB1.Worksheets(MyArray).Select
 
    ChDir repertoire
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "OVH analysis (Synth) " & Userform1.Bookliste.Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
 
' Process de suppresion des feuilles (VERSION SYNTHETIQUE)
Sheets("RESTIT OVH").Select
ActiveSheet.Next.Select
While ActiveSheet.Name <> "-"
Nbligne1 = Nbligne1 + 1
Userform1.ProgressBar1.Value = (Nbligne1 / Nbligne2) * 100
ActiveWindow.SelectedSheets.Delete
Wend
 
Unload Userform1
 
Sheets("Control panel").Select
 
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub
Sub Copiedetl()
 
Dim Derlig As Byte
Dim Prelig As Byte
Dim Colonne As Byte
Dim colonneOVH As Byte
Dim Resp As String
Dim RespRestit As String
Dim nomonglet As String
Dim borne1 As String
Dim borne2 As String
Dim WB1 As Workbook
Dim MyArray() As String
Dim y As Integer, z As Byte
Dim repertoire As String
Dim Wbname As String
Dim Nbligne1 As Byte
Dim Nbligne2 As Byte
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Wbname = ThisWorkbook.Name
repertoire = ActiveWorkbook.Path
 
' Process de localisation de la liste
Sheets("Impression").Select
colonneOVH = Application.Match("RESTIT OVH", Range("A2:Z2"), 0)
Colonne = Application.Match(Userform1.Bookliste.Value, Range("A2:Z2"), 0)
Range("A1").End(xlDown).Offset(0, Colonne - 1).End(xlUp).Select
Derlig = ActiveCell.Row
 
Range("A1").End(xlDown).Offset(0, Colonne - 1).End(xlUp).Select
ActiveCell.End(xlUp).Offset(2, 0).Select
Prelig = ActiveCell.Row
 
RespRestit = Cells(Prelig - 1, Colonne).Value
Sheets("Restit ovh").Select
Range("B9").Value = RespRestit
Range("B142").Value = RespRestit
 
Nbligne2 = (Derlig * 4) - (Premlig * 4)
Nbligne1 = 0
 
' Process de recopie de l'onglet source (VERSION DETAIL)
For i = Prelig To Derlig
 
   Sheets("Impression").Select
   Cells(i, Colonne).Select
   Resp = ActiveCell.Value
   Cells(i, colonneOVH).Select
   nomonglet = ActiveCell.Value
   Sheets("RESTIT OVH").Select
   Sheets("RESTIT OVH").Copy Before:=Sheets("-")
   ActiveSheet.Name = nomonglet
   Range("B9").Value = Resp
   Range("B142").Value = Resp
 
If Range("AA1").Value = 0 Then
ActiveSheet.PageSetup.PrintArea = "$B$9:$V$139"
End If
 
Nbligne1 = Nbligne1 + 1
Userform1.ProgressBar1.Value = (Nbligne1 / Nbligne2) * 100
 
Next
 
'Process de création du PDF (VERSION DETAIL)
 
borne1 = Sheets("- ").Index + 1
borne2 = Sheets("-").Index - 1
 
For i = borne1 + 2 To borne2
      Worksheets(i).Select
ActiveSheet.PageSetup.PrintArea = "$B$9:$V$139,$B$142:$I$272"
 
If Range("AA1").Value = 0 Then
ActiveSheet.PageSetup.PrintArea = "$B$9:$V$139"
End If
 
Nbligne1 = Nbligne1 + 1
Userform1.ProgressBar1.Value = (Nbligne1 / Nbligne2) * 100
 
 With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.196850393700787)
        .RightMargin = Application.InchesToPoints(0.196850393700787)
        .TopMargin = Application.InchesToPoints(0.15748031496063)
        .BottomMargin = Application.InchesToPoints(0.15748031496063)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 40
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
 
 
Next
 
Sheets("Restit OVH").Select
ActiveSheet.PageSetup.PrintArea = "$B$9:$V$139,$B$142:$I$272"
 
 With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.196850393700787)
        .RightMargin = Application.InchesToPoints(0.196850393700787)
        .TopMargin = Application.InchesToPoints(0.15748031496063)
        .BottomMargin = Application.InchesToPoints(0.15748031496063)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 40
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
 
Set WB1 = ThisWorkbook
 
    For y = borne1 To borne2
        ReDim Preserve MyArray(z)
        MyArray(z) = Sheets(y).Name
           z = z + 1
           Nbligne1 = Nbligne1 + 1
        Userform1.ProgressBar1.Value = (Nbligne1 / Nbligne2) * 100
        Next
 
            WB1.Worksheets(MyArray).Select
 
    ChDir repertoire
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "OVH analysis (Detailed) " & Userform1.Bookliste.Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
 
' Process de suppresion des feuilles (VERSION DETAIL)
Sheets("RESTIT OVH").Select
ActiveSheet.Next.Select
While ActiveSheet.Name <> "-"
Nbligne1 = Nbligne1 + 1
Userform1.ProgressBar1.Value = (Nbligne1 / Nbligne2) * 100
ActiveWindow.SelectedSheets.Delete
Wend
 
Unload Userform1
 
Sheets("Control panel").Select
 
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub

Pour l'âme charitable qui regardera de plus près a mes problèmes, toutes les listes fonctionnent excepté la liste "Full book (Vex & Contrib included)" qui est la plus longue (Cf charge de travail Excel?!)

Par ailleurs je suis preneur de toute remarque constructive sur l’exécution de mon code. Je ne reste qu'un néophyte dans le monde VBA.

Bien amicalement,

A. FOSTY

PS: Navré pour le titre peu explicite mais ne sachant moi même pas qualifier l'erreur, il est ardue de la mettre en titre...

**ARTURO83** · 05/12/2018, 04h41

Bonjour,

Il est probable que lors du déroulement du programme, il y ait une action nécessitant un certain temps pour qu'elle soit correctement traitée, et qu'elle serait écourtée par l'exécution des lignes de code suivantes.
Il faut, si c'est le cas, que le programme s'arrête tant que l'action n'est pas terminée. Pour cela, il faut ajouter une ligne avec DoEvents pour laisser au programme le temps de finir ce qu'on lui demande avant de passer à la ligne suivante.
Reste à savoir dans votre code quelle est l'action qui met du temps à s'exécuter et mettre DoEvents juste après.

Code :

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

1
2
3
   'exécution Action longue
    DoEvents
    'Suite du Programme

A vous de placer ce DoEvents au bon endroit.

Cdlt

**Afosty** · 06/12/2018, 16h04

Bonjour Arturo,

Merci pour ta réponse !

En revanche, le Doevents n'améliore pas la situation. Je ne comprends vraiment pas.

Mon code fonctionne sans accro à l'exception du changement de format dans le fichier PDF.. Quelle pourrait être l'origine du problème ?

Bien amicalement,

A. FOSTY

**patricktoulon** · 06/12/2018, 17h01

re
probablement 2016 sur W10 et donc l'imprimante pdf par defaut de W10

la police de caracteres n'est pas dispo tout simplement pour cette imprimante il y a une discussion recente qui traite le meme sujet il faut chercher un peu

**Afosty** · 06/12/2018, 17h09

Bonjour Patrick,

Il ne me semble pas que ce soit un problème de compatibilité de Windows/Excel avec les polices. En effet, les 5 première fois qu'on Run la macro il n'y a aucun problèmes n'y de police n'y de templates.

Le problème survient après avoir publier plusieurs PDF (50aine de pages a chaque fois).

Le premier symptôme est un dérèglement de la police à partir d'un page X dans le fichier PDF. Ensuite si on Re run la macro, le fichier PDF est vide.

Je suis actuellement sur la piste de cleaner toutes mes variables à la fin de mon code. Pensez-vous que cela puisse aider ?

Bien amicalement,

A. FOSTY

**patricktoulon** · 06/12/2018, 17h14

je l'ignore mais ca soulagera la memoire alouée a l'instance de l'application excel ca c'est sur

apres si tu me dit que le dérèglement est proportionel au nombre de pages effectivement je pense que c'est encore un soucis de memoire
c'est a se demander (qu'est ce qu'ils ont foutu avec cette version ) plein plein de problemes dus a la memoire

Erreur de macro sur création de PDF

Macros et VBA Excel

Vue hybride

Partager

Partager