Code d'export d'une feuille graphique en image ne fonctionne pas

**Vincent32** · 17/02/2012, 09h01

Bonjour à tous,

J'ai une macro qui m'insère dans des feuilles graphiques des graphiques !!!!

J'ai ensuite un userform constitué de checkbox (ces dernières me permettent de sélectionner des feuilles) et d'option button (ceux ci me permettent de sélectionner une imprimante). La combinaison des deux me permet d'imprimer les feuilles graphiques sélectionnées sur l'imprimante désirée. J'aimerai ajouter une option d'export de mes Feuilles graphiques (et non les graphiques seuls) au format png ou gif ou jpg (peu importe). J'ai trouvé plusieurs infos sur ce forum et dans la faq, cependant je n'arrive pas à adapter les solutions proposées à mon problème. Voici mon 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
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
Private Sub Imprimer_Click()
 Dim FName1 As String, FName2 As String, FName3 As String, FName4 As String, FName5 As String, FName6 As String, FName7 As String, FName8 As String, FName9 As String, FName10 As String, FName11 As String
 
    If CheckBox2 = False And CheckBox3 = False And CheckBox4 = False And CheckBox5 = False And CheckBox6 = False And CheckBox7 = False And CheckBox8 = False And CheckBox9 = False And CheckBox10 = False And CheckBox11 = False And CheckBox12 = False Then
        Select Case MsgBox("Veuillez sélectionner au moins une feuille à imprimer.", vbOKCancel + vbCritical, "Erreur : Aucune feuille n'est sélectionnée pour l'impression !")
            Case vbOK
            Case vbCancel
                Unload UserForm2
                Exit Sub
        End Select
    Else
        If CheckBox13 = False Then
            If OptionButton1 = True Then 'impression sur ISIMP116
                Application.ActivePrinter = "\\isnts37\ISIMP116 sur Ne03:"
                If CheckBox2 = True Then
                    Sheets("Spectre total").PrintOut 'impression de la feuille Données brutes
                End If
                If CheckBox3 = True Then
                    Sheets("Soustraction").PrintOut 'impression de la feuille Soustraction
                End If
                If CheckBox11 = True Then
                    Sheets("Zone groupements hydroxyles").PrintOut 'impression de la feuille Correction masse et surface
                End If
                If CheckBox4 = True Then
                    Sheets("Zone sulfure").PrintOut 'impression de la feuille Correction ligne de base
                End If
                If CheckBox5 = True Then
                    Sheets("N-(N-1)").PrintOut 'impression de la feuille N-(N-1)
                End If
                If CheckBox6 = True Then
                    Sheets("Dérivée première").PrintOut 'impression de la feuille Dérivée première
                End If
                If CheckBox7 = True Then
                    Sheets("Dérivée seconde").PrintOut 'impression de la feuille Dérivée seconde
                End If
                If CheckBox8 = True Then
                    Sheets("Correction masse").PrintOut 'impression de la feuille Correction masse
                End If
                If CheckBox9 = True Then
                    Sheets("Correction surface").PrintOut 'impression de la feuille Correction surface
                End If
                If CheckBox10 = True Then
                    Sheets("Correction masse et surface").PrintOut 'impression de la feuille Correction masse et surface
                End If
                If CheckBox12 = True Then
                    Sheets("Zoom zone sulfure").PrintOut 'impression de la feuille Correction masse et surface
                End If
                MsgBox ("Impression couleur réalisée sur ISIMP116 (Bloc F)")
            Else
 
             'impression sur ISIMP135
            Application.ActivePrinter = "\\isnts37\ISIMP135 sur Ne04:"
                If CheckBox2 = True Then
                    Sheets("Spectre total").PrintOut 'impression de la feuille Données brutes
                End If
                If CheckBox3 = True Then
                    Sheets("Soustraction").PrintOut 'impression de la feuille Soustraction
                End If
                If CheckBox11 = True Then
                    Sheets("Zone groupements hydroxyles").PrintOut 'impression de la feuille Correction masse et surface
                End If
                If CheckBox4 = True Then
                    Sheets("Zone sulfure").PrintOut 'impression de la feuille Correction ligne de base
                End If
                If CheckBox5 = True Then
                    Sheets("N-(N-1)").PrintOut 'impression de la feuille N-(N-1)
                End If
                If CheckBox6 = True Then
                    Sheets("Dérivée première").PrintOut 'impression de la feuille Dérivée première
                End If
                If CheckBox7 = True Then
                    Sheets("Dérivée seconde").PrintOut 'impression de la feuille Dérivée seconde
                End If
                If CheckBox8 = True Then
                    Sheets("Correction masse").PrintOut 'impression de la feuille Correction masse
                End If
                If CheckBox9 = True Then
                    Sheets("Correction surface").PrintOut 'impression de la feuille Correction surface
                End If
                If CheckBox10 = True Then
                    Sheets("Correction masse et surface").PrintOut 'impression de la feuille Correction masse et surface
                End If
                If CheckBox12 = True Then
                    Sheets("Zoom zone sulfure").PrintOut 'impression de la feuille Correction masse et surface
                End If
                MsgBox ("Impression noir&blanc réalisée sur ISIMP135 (Bloc G)")
            End If
 
            If OptionButton3 = True Then 'impression sur ISIMP159
            Application.ActivePrinter = "\\isnts37\ISIMP159 sur Ne05:"
                If CheckBox2 = True Then
                    Sheets("Spectre total").PrintOut 'impression de la feuille Données brutes
                End If
                If CheckBox3 = True Then
                    Sheets("Soustraction").PrintOut 'impression de la feuille Soustraction
                End If
                If CheckBox11 = True Then
                    Sheets("Zone groupements hydroxyles").PrintOut 'impression de la feuille Correction masse et surface
                End If
                If CheckBox4 = True Then
                    Sheets("Zone sulfure").PrintOut 'impression de la feuille Correction ligne de base
                End If
                If CheckBox5 = True Then
                    Sheets("N-(N-1)").PrintOut 'impression de la feuille N-(N-1)
                End If
                If CheckBox6 = True Then
                    Sheets("Dérivée première").PrintOut 'impression de la feuille Dérivée première
                End If
                If CheckBox7 = True Then
                    Sheets("Dérivée seconde").PrintOut 'impression de la feuille Dérivée seconde
                End If
                If CheckBox8 = True Then
                    Sheets("Correction masse").PrintOut 'impression de la feuille Correction masse
                End If
                If CheckBox9 = True Then
                    Sheets("Correction surface").PrintOut 'impression de la feuille Correction surface
                End If
                If CheckBox10 = True Then
                    Sheets("Correction masse et surface").PrintOut 'impression de la feuille Correction masse et surface
                End If
                If CheckBox12 = True Then
                    Sheets("Zoom zone sulfure").PrintOut 'impression de la feuille Correction masse et surface
                End If
            End If
 
            If CheckBox13 = True Then 'export en image
                If CheckBox2 = True Then
                    With Sheets("Spectre total")
                        FName1 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName1, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox3 = True Then
                    With Sheets("Soustraction")
                        FName2 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName2, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox11 = True Then
                    With Sheets("Zone groupements hydroxyles")
                        FName3 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName3, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox4 = True Then
                    With Sheets("Zone sulfure")
                        FName4 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName4, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox5 = True Then
                    With Sheets("N-(N-1)")
                        FName5 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName5, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox6 = True Then
                    With Sheets("Dérivée première")
                        FName6 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName6, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox7 = True Then
                    With Sheets("Dérivée seconde")
                        FName7 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName7, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox8 = True Then
                    With Sheets("Correction masse")
                        FName8 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName8, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox9 = True Then
                    With Sheets("Correction surface")
                        FName9 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName9, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox10 = True Then
                    With Sheets("Correction masse et surface")
                        FName10 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName10, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox12 = True Then
                    With Sheets("Zoom zone sulfure")
                        FName11 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName11, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
            End If
            Unload UserForm2
    End If
    End If
End Sub

Voici la partie du code qui ne fonctionne pas correctement (aucun msg d'erreur cependant) :

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
 If CheckBox13 = True Then 'export en image
                If CheckBox2 = True Then
                    With Sheets("Spectre total")
                        FName1 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName1, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox3 = True Then
                    With Sheets("Soustraction")
                        FName2 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName2, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox11 = True Then
                    With Sheets("Zone groupements hydroxyles")
                        FName3 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName3, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox4 = True Then
                    With Sheets("Zone sulfure")
                        FName4 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName4, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox5 = True Then
                    With Sheets("N-(N-1)")
                        FName5 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName5, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox6 = True Then
                    With Sheets("Dérivée première")
                        FName6 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName6, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox7 = True Then
                    With Sheets("Dérivée seconde")
                        FName7 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName7, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox8 = True Then
                    With Sheets("Correction masse")
                        FName8 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName8, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox9 = True Then
                    With Sheets("Correction surface")
                        FName9 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName9, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox10 = True Then
                    With Sheets("Correction masse et surface")
                        FName10 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName10, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
                If CheckBox12 = True Then
                    With Sheets("Zoom zone sulfure")
                        FName11 = Application.GetSaveAsFilename("", "Fichier Gif (*.GIF),*.GIF,Fichier JPEG (*.JPG),*.JPG,Tous fichiers (*.*),*.*")
                        .Export Filename:=FName11, FilterName:=TypeImg, Interactive:=True
                    End With
                End If
            End If

Merci pour votre aide

**mercatog** · 17/02/2012, 13h32

Ci-joint une exemple pour exporter la feuille graphique nommée Graph1 vers le bureau.

A adapter à ton cas:

Code :

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

1
2
3
4
5
6
7
8
9
10
 
'Chrt: la feuille graphique à exporter en image
'Chemin: Dossier où exporter
'NomImg: Nom à donner au fichier image généré
 
Private Sub ExportChart(ByVal Chrt As Chart, ByVal Chemin As String, ByVal NomImg As String)
 
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
Chrt.Export Filename:=Chemin & NomImg & ".png"
End Sub

Pour tester:

Code :

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

1
2
3
4
Sub Test()
 
Call ExportChart(ThisWorkbook.Sheets("Graph1"), "C:\Documents and Settings\Administrateur\Bureau\", "MonImage")
End Sub

Code d'export d'une feuille graphique en image ne fonctionne pas

Macros et VBA Excel

Discussions similaires

Partager

Partager