Discussion :

[Peall13]

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 :

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

[Menhir]

Ceci pourrait t'aider :
http://www.developpez.net/forums/d43...r/#post6594777
http://www.developpez.net/forums/d43...r/#post7781358
Fouille dans les autres messages de ce sujet.

[kiki29]

Salut, voir en bas de ce post#1 : Impression de certaines Feuilles d'un classeur via un tableau dans un seul Pdf résultant, en l'adaptant à ton contexte.

A voir également : Impression/Fusion de certains onglets d'un classeur en PDF

[Peall13]

Bonjour,

Merci à vous 2 pour vos conseils

Du coup j'ai opté pour la copie des graphiques sur un nouvel onglet avant l'impression et ça fonctionne !

Seul petit souci, le PDF me génère une page blanche entre chaque graphique, mais bon je verais ça en temps voulu.

Merci encore.

PS pour info voici le code :

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
'Procédure pour impression PDF
Set wsTemp = Sheets.Add
Ma_cell = 1
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).ChartObjects(Mon_Graph).Select
ThisWorkbook.Sheets(Ma_Sheet).ChartObjects(Mon_Graph).Copy
wsTemp.Range("A" & Ma_cell).Select
ActiveSheet.Paste
wsTemp.ChartObjects(Mon_Graph).Width = 792
wsTemp.ChartObjects(Mon_Graph).Height = 599
 
End If
Ma_cell = Ma_cell + 37
ActiveSheet.HPageBreaks.Add Before:=Range("A" & Ma_cell)
Next i
 
    With wsTemp.PageSetup
       .Orientation = xlLandscape
        .Zoom = False
        .PrintArea = wsTemp.UsedRange
    End With
   Application.PrintCommunication = True
    wsTemp.PrintOut
 
Application.DisplayAlerts = False
wsTemp.Delete
 
Application.DisplayAlerts = True

[kiki29]

Salut, pour le balisage de ton code : Balisage
Après pour l'indenter proprement, il existe pour Office < 2013 : Smart Indenter