Impression de plusieurs graphiques dans le même PDF avec un array
Bonjour,
Je galère depuis quelques heures, merci d'avance à ceux qui pourront m'aider.
Jai un classeur excel avec 18 graphiques, j'ai créé un Userform ou l'on peut choisir les graphique à imprimer via des checkbox. Dans ma procédure d'impression j'ai 2 étapes :
- La 1 ere est si l'utilisateur fait une impression papier, je boucle sur le nombre de checkbox coché et j'imprimle un graphique par feuille est ça marche nikel !
- La 2 eme est le choix de l'impression PDF, et la sa ce gate, pour imprimé 1 graphique sur le PDF pas de souci, par contre plusieurs sur le même PDF, je n'arrive pas à trouver la syntaxe adéquate et pourtant j'ai épluché la toile et dans toute les langues depuis ce matin ....:( J'ai bien eu l'idée de stocker les graphiques sélectionné dans un array mais j'ai l'impression que c'est pas prévu à cet effet lors de l'impression.
Merci
Voici le code :
Code:
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
| Sub Print_Doc_Search()
Dim x As Boolean
Dim Actuel_Champ As Object
Dim New_Champ As String
Dim Nb_Graph As Byte
Dim MyVal() As ChartObject
Dim Ma_Sheet() As String
Dim Mon_Graph() As String
x = Application.Dialogs(xlDialogPrinterSetup).Show
If x = False Then
Exit Sub
End If
If Choix_Print.Choix_1 = True Then
Nb_Graph = 0
For i = 1 To 14
New_Champ = "Graph" & i
Set Actuel_Champ = Choix_Print(New_Champ)
If Actuel_Champ.Value = True Then
Nb_Graph = Nb_Graph + 1
End If
Next i
'Procédure d'impression papier
For i = 1 To Nb_Graph
New_Champ = "Graph" & i
Set Actuel_Champ = Choix_Print(New_Champ)
If Actuel_Champ.Value = True Then
Ma_Sheet = Actuel_Champ.Tag
Mon_Graph = Actuel_Champ.Caption
ThisWorkbook.Sheets(Ma_Sheet).DisplayAutomaticPageBreaks = False
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ThisWorkbook.Sheets(Ma_Sheet).Activate
With ActiveSheet.ChartObjects(Mon_Graph).Chart.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.15)
.FooterMargin = Application.InchesToPoints(0.15)
'.PrintHeadings = False
.PrintGridlines = False
'.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
'.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.FitToPagesWide = 1
.FitToPagesTall = 1
'.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
Application.PrintCommunication = True
ActiveSheet.ChartObjects(Mon_Graph).Chart.PrintOut Copies:=1 ', Collate:=True, IgnorePrintAreas:=True
Application.ScreenUpdating = False
End If
Next i
Else
'Procédure pour impression PDF
n = 0
For i = 1 To Nb_Graph
New_Champ = "Graph" & i
Set Actuel_Champ = Choix_Print(New_Champ)
If Actuel_Champ.Value = True Then
ReDim Preserve Ma_Sheet(1 To n)
Ma_Sheet(n) = Actuel_Champ.Tag
ReDim PreserveMon_Graph(1 To n)
Mon_Graph(n) = Actuel_Champ.Caption
n = n + 1
End If
Next i
'impression du pack de graphique selectionné
'L'idée me semble viable mais la syntaxe me fait défaut
ThisWorkbook.Sheets(Array(Ma_Sheet)).ChartObjects(Array(Mon_Graph)).Chart.PrintOut Copies:=1, Collate:=True
End If
End Sub |
