Impression PDF avec plusieurs feuilles selon case à cocher

**Roussette35** · 04/12/2014, 23h25

Bonjour

Je souhaite réaliser une macro sous excel pour imprimer un pdf sous excel
La première partie fonctionne bien. Je crée bien un fichier pdf commençant par la feuille COUV et suivi de SOMMAIRE.
Je souhaiterais ajouter la feuille Annexe 1 si elle est cochée et/ou l'Annexe 2 si elle est cochée au pdf à suivre de la page SOMMAIRE.
~~ci-joint le fichier excel.~~

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Impression()
'
' Impression Macro
 
    Sheets(Array("COUV", "SOMMAIRE")).Select
    Sheets("COUV").Activate
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\temp\test.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
    Sheets("EDITION").Select
 
End Sub

Merci de votre aide par avance

**kiki29** · 05/12/2014, 03h53

Salut, de façon basique et sommaire qqch comme ceci, cependant à adapter à ton contexte ( chemin, contrôles activex ) ici j'ai supposé des contrôles formulaires et non activex situés sur la feuille EDITION ?

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
Option Explicit
 
Sub Impression()
    Application.ScreenUpdating = False
 
    Sheets(Array("COUV", "SOMMAIRE")).Select
 
    If Sheets("EDITION").CheckBoxes("chkAnnexe1").Value = 1 Then
        Sheets(Array("COUV", "SOMMAIRE", "ANNEXE1")).Select
    End If
 
    If Sheets("EDITION").CheckBoxes("chkAnnexe2").Value = 1 Then
        Sheets(Array("COUV", "SOMMAIRE", "ANNEXE2")).Select
    End If
 
    If Sheets("EDITION").CheckBoxes("chkAnnexe1").Value = 1 And _
            Sheets("EDITION").CheckBoxes("chkAnnexe2").Value = 1 Then
        Sheets(Array("COUV", "SOMMAIRE", "ANNEXE1", "ANNEXE2")).Select
    End If
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            ThisWorkbook.Path & "\" & "test.pdf", Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
 
    Application.ScreenUpdating = True
    Sheets("EDITION").Select
End Sub

si ActiveX

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
Option Explicit
 
Sub Impression_02()
    Application.ScreenUpdating = False
    Sheets(Array("COUV", "SOMMAIRE")).Select
 
    If Sheets("EDITION").CheckBox1.Value = True Then
        Sheets(Array("COUV", "SOMMAIRE", "ANNEXE1")).Select
    End If
 
    If Sheets("EDITION").CheckBox2.Value = True Then
        Sheets(Array("COUV", "SOMMAIRE", "ANNEXE2")).Select
    End If
 
    If Sheets("EDITION").CheckBox1.Value = True And _
            Sheets("EDITION").CheckBox2.Value = True Then
        Sheets(Array("COUV", "SOMMAIRE", "ANNEXE1", "ANNEXE2")).Select
    End If
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            ThisWorkbook.Path & "\" & "test.pdf", Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
 
    Application.ScreenUpdating = True
    Sheets("EDITION").Select
End Sub

**Roussette35** · 10/12/2014, 14h08

Sur l'exemple, je n'avais noté qu'une annexe mais dans mon fichier j'en ai 10 annexes donc à moins de créer toutes les combinaisons probables d'impression. Est-ce qu'il n'existe pas une solution plus simple, qui dit que si coché, je l'insère au fichier pdf... ?

Merci d'avance

**kiki29** · 10/12/2014, 17h00

Salut, la solution plus haut est vraiment bestiale et mal pensée.
Tu es bien gentille mais je ne pratique pas l'extispicine , donc plus fonctionnel et pensé (?) , à toi d'adapter à ton contexte.

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
Option Explicit
Option Base 1
 
Sub Impression_02()
Dim ArWsh() As String
Dim i As Long, n As Long
Dim Coll As Collection
 
    Application.ScreenUpdating = False
 
    Set Coll = New Collection
 
    Coll.Add "COUV"
    Coll.Add "SOMMAIRE"
 
    With Sheets("EDITION")
        If .CheckBoxes("chkAnnexe1").Value = 1 Then Coll.Add "ANNEXE1"
        If .CheckBoxes("chkAnnexe2").Value = 1 Then Coll.Add "ANNEXE2"
        If .CheckBoxes("chkAnnexe3").Value = 1 Then Coll.Add "ANNEXE3"
        If .CheckBoxes("chkAnnexe4").Value = 1 Then Coll.Add "ANNEXE4"
        If .CheckBoxes("chkAnnexe5").Value = 1 Then Coll.Add "ANNEXE5"
        If .CheckBoxes("chkAnnexe6").Value = 1 Then Coll.Add "ANNEXE6"
        If .CheckBoxes("chkAnnexe7").Value = 1 Then Coll.Add "ANNEXE7"
        If .CheckBoxes("chkAnnexe8").Value = 1 Then Coll.Add "ANNEXE8"
        If .CheckBoxes("chkAnnexe9").Value = 1 Then Coll.Add "ANNEXE9"
        If .CheckBoxes("chkAnnexe10").Value = 1 Then Coll.Add "ANNEXE10"
    End With
 
    n = Coll.Count
    ReDim ArWsh(n)
    For i = 1 To n
        ArWsh(i) = Coll(i)
    Next i
 
    Sheets(ArWsh).Select
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            ThisWorkbook.Path & "\" & "test.pdf", Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
 
    Erase ArWsh
    Set Coll = Nothing
 
    Application.ScreenUpdating = True
 
    With Sheets("EDITION")
        .Select
        .Range("B1").Select
    End With
End Sub
 
Private Sub PosBoutons()
Dim T As Range
    Application.ScreenUpdating = False
    With Feuil1
        .Activate
 
        Set T = .Cells(1, 3)
        With .Shapes("chkAnnexe1")
            .Left = T.Left
            .Top = T.Top
            .Width = 60
            .Height = Rows(1).RowHeight - 5
        End With
 
        With .Shapes("chkAnnexe2")
            .Left = Feuil1.Shapes("chkAnnexe1").Left
            .Top = Feuil1.Shapes("chkAnnexe1").Top + Feuil1.Shapes("chkAnnexe1").Height
            .Width = Feuil1.Shapes("chkAnnexe1").Width
            .Height = Feuil1.Shapes("chkAnnexe1").Height
        End With
 
        With .Shapes("chkAnnexe3")
            .Left = Feuil1.Shapes("chkAnnexe1").Left
            .Top = Feuil1.Shapes("chkAnnexe2").Top + Feuil1.Shapes("chkAnnexe2").Height
            .Width = Feuil1.Shapes("chkAnnexe1").Width
            .Height = Feuil1.Shapes("chkAnnexe1").Height
        End With
 
        With .Shapes("chkAnnexe4")
            .Left = Feuil1.Shapes("chkAnnexe1").Left
            .Top = Feuil1.Shapes("chkAnnexe3").Top + Feuil1.Shapes("chkAnnexe3").Height
            .Width = Feuil1.Shapes("chkAnnexe1").Width
            .Height = Feuil1.Shapes("chkAnnexe1").Height
        End With
 
        With .Shapes("chkAnnexe5")
            .Left = Feuil1.Shapes("chkAnnexe1").Left
            .Top = Feuil1.Shapes("chkAnnexe4").Top + Feuil1.Shapes("chkAnnexe4").Height
            .Width = Feuil1.Shapes("chkAnnexe1").Width
            .Height = Feuil1.Shapes("chkAnnexe1").Height
        End With
 
        With .Shapes("chkAnnexe6")
            .Left = Feuil1.Shapes("chkAnnexe1").Left
            .Top = Feuil1.Shapes("chkAnnexe5").Top + Feuil1.Shapes("chkAnnexe5").Height
            .Width = Feuil1.Shapes("chkAnnexe1").Width
            .Height = Feuil1.Shapes("chkAnnexe1").Height
        End With
 
        With .Shapes("chkAnnexe7")
            .Left = Feuil1.Shapes("chkAnnexe1").Left
            .Top = Feuil1.Shapes("chkAnnexe6").Top + Feuil1.Shapes("chkAnnexe6").Height
            .Width = Feuil1.Shapes("chkAnnexe1").Width
            .Height = Feuil1.Shapes("chkAnnexe1").Height
        End With
 
        With .Shapes("chkAnnexe8")
            .Left = Feuil1.Shapes("chkAnnexe1").Left
            .Top = Feuil1.Shapes("chkAnnexe7").Top + Feuil1.Shapes("chkAnnexe7").Height
            .Width = Feuil1.Shapes("chkAnnexe1").Width
            .Height = Feuil1.Shapes("chkAnnexe1").Height
        End With
 
        With .Shapes("chkAnnexe9")
            .Left = Feuil1.Shapes("chkAnnexe1").Left
            .Top = Feuil1.Shapes("chkAnnexe8").Top + Feuil1.Shapes("chkAnnexe8").Height
            .Width = Feuil1.Shapes("chkAnnexe1").Width
            .Height = Feuil1.Shapes("chkAnnexe1").Height
        End With
 
        With .Shapes("chkAnnexe10")
            .Left = Feuil1.Shapes("chkAnnexe1").Left
            .Top = Feuil1.Shapes("chkAnnexe9").Top + Feuil1.Shapes("chkAnnexe9").Height
            .Width = Feuil1.Shapes("chkAnnexe1").Width
            .Height = Feuil1.Shapes("chkAnnexe1").Height
        End With
 
        .Range("B1").Select
    End With
 
    Application.ScreenUpdating = False
End Sub

Impression PDF avec plusieurs feuilles selon case à cocher

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager