Erreur de macro sur création de PDF

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

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...

Erreur de macro sur création de PDF

Macros et VBA Excel

Mode arborescent

Partager

Partager