Bonjour à Tous,

Je suis un débutant dans l'embarras...J'ai parcouru plusieurs Forum, ça fait 24 heures que je bataille sur ce truc.
Pour mon stage je dois automatiser un tableau de bord avec des graphiques et des tableaux.

Premièrement j'ai une classe pour exporter les graphiques, puis une classe pour exporter les tableaux. Je n'arrive pas à fusionner les deux classes par manque
de savoir. j'aimerai créer un bouton qui exécute les 2 classes: Sub GraphExcel_vers_PowerPoint() et
Sub TableauexportPPT()

Deuxièmement, lorsque l'export se fait sur powerpoint. Je ne veux surtout pas que le graphique soit en tant qu'image. Parfois ça fonctionne, le copier coller se fait en gardant la mise en forme de type excel et parfois c'est une image.

Mon code n'est pas du tout optimiser mais j'essaye de faire de mon mieux :
MERCI à ceux qui veulent m'aider et pour votre pédagogie.


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
 
Sub GraphExcel_vers_PowerPoint()
                Dim sPPTFileName As String
                Dim ppApp As PowerPoint.Application
                Dim ppPres As PowerPoint.Presentation
                Dim cht As Excel.ChartObject
 
 
 
 
                    'Sélectionner le fichier PowerPoint à ouvrir
                       sPPTFileName = GetFileName
 
'Ouvrir PowerPoint
                   Set ppApp = CreateObject("PowerPoint.Application")
                   ppApp.Visible = msoTrue
                   Set ppPres = ppApp.Presentations.Open(sPPTFileName)
                   ppApp.ActiveWindow.ViewType = ppViewSlide
 
                        ' >>>>>>>>
                           'Appel de la fonction pour copier graphique dans PowerPoint
                           'Graphique no1
 
                        Set cht = ThisWorkbook.Sheets("SUIVI DES COMMANDES").ChartObjects("Graphique 1")
                        Call ChartsToPPT(ppPres, 2, cht, 130, 225, 465, 275)
 
                        'Set cht = ThisWorkbook.Sheets("SUIVI DES COMMANDES").
                        'Call ChartsToPPT(ppPres, 2, cht, 130, 405, 465, 150)
 
 
 
                        Set cht = ThisWorkbook.Sheets("SOCLE FIXE").ChartObjects("Graphique 1")
                        Call ChartsToPPT(ppPres, 2, cht, 335, 34, 170, 170) 'SOCLE PLACE
 
 
                        Set cht = ThisWorkbook.Sheets("SUIVI DES LIVRAISONS").ChartObjects("Graphique 1")
                        Call ChartsToPPT(ppPres, 3, cht, 130, 225, 465, 275)
 
                        Set cht = ThisWorkbook.Sheets("SUIVI DES LIVRAISONS").ChartObjects("Graphique 2")
                        Call ChartsToPPT(ppPres, 3, cht, 334, 36, 169, 159)
 
                        Set cht = ThisWorkbook.Sheets("SUIVI DES RECEPTIONS").ChartObjects("Graphique 1")
                        Call ChartsToPPT(ppPres, 4, cht, 130, 225, 465, 275)
 
                        Set cht = ThisWorkbook.Sheets("SUIVI DES VALIDATIONS").ChartObjects("Graphique 2")
                        Call ChartsToPPT(ppPres, 5, cht, 130, 225, 465, 275)
 
                        Set cht = ThisWorkbook.Sheets("SUIVI DES REFUS").ChartObjects("Graphique 1")
                        Call ChartsToPPT(ppPres, 6, cht, 130, 225, 465, 275)
 
                        Set cht = ThisWorkbook.Sheets("SUIVI DES RETARDS").ChartObjects("Graphique 1")
                        Call ChartsToPPT(ppPres, 7, cht, 130, 225, 465, 275)
 
 
 
 
 
 
 
                            Set cht = Nothing
                            Set ppPres = Nothing
                            Set ppApp = Nothing
 
End Sub
 
 
 'Code pour copier le graphique spécifié dans la présentation
Sub ChartsToPPT(oPPT As PowerPoint.Presentation, iSlideNo As Integer, _
                cht As ChartObject, iTop As Integer, iLeft As Integer, iWidth As Integer, iHeight As Integer)
 
                   Dim ppSlide As PowerPoint.Slide
                   Dim pSh As PowerPoint.Shape
   'Choisir la diapositive
                   Set ppSlide = oPPT.Slides(iSlideNo)
 
                   cht.Copy
 
                   With ppSlide
                      .Shapes.PasteSpecial 'ppPasteDefault
                      'Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
', SkipBlanks:=False, Transpose:=False
                      Set pSh = .Shapes(.Shapes.Count)  '.Select  'Select the last shape
                   End With
 
   'Position et dimensions
                   With pSh
                      .Top = iTop
                      .Left = iLeft
                      .Width = iWidth
                      .Height = iHeight
                   End With
 
End Sub
 
Function GetFileName() As String
   Dim sFileName As Variant
   Dim sFileFilter As String, sTitle As String
 
   'sFileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file"
   sFileFilter = "PowerPoint Files (*.ppt*), *.ppt*"
   sTitle = "Please select a file"
   sFileName = Application.GetOpenFilename(sFileFilter, , sTitle)
   If sFileName <> False Then
      GetFileName = sFileName
 
   End If
End Function
 
 
 
Sub TableauexportPPT()
   'nécessite d'activer la référence Microsoft Powerpoint Object Library
    Dim PPT As PowerPoint.Application
    Dim PptDoc As PowerPoint.Presentation
    Dim NbShpe As Byte
 
 
   sPPTFileName = GetFileName
    Set PPT = CreateObject("Powerpoint.Application")
    PPT.Visible = True 'l'application sera visible
    Set PptDoc = PPT.Presentations.Open(sPPTFileName)
 
 
    'premier tableau
 
        ThisWorkbook.Worksheets("SUIVI DES COMMANDES").Range("C33:O38").Copy
 
        PptDoc.Slides(2).Shapes.PasteSpecial ppPasteDefault 'ppPasteEnhancedMetafile
 
        NbShpe = PptDoc.Slides(2).Shapes.Count
 
        With PptDoc.Slides(2).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 224
            .Top = 290
            .Height = 77
            .Width = 480
 
        End With
 
 
 
            ThisWorkbook.Worksheets("SUIVI DES LIVRAISONS").Range("C41:O46").Copy
 
        PptDoc.Slides(3).Shapes.PasteSpecial ppPasteDefault 'ppPasteEnhancedMetafile
 
        NbShpe = PptDoc.Slides(3).Shapes.Count
 
    '2 eme tableau
        With PptDoc.Slides(3).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 224
            .Top = 290
            .Height = 77
            .Width = 480
 
        End With
 
 
                ThisWorkbook.Worksheets("SUIVI DES RECEPTIONS").Range("C41:O46").Copy
 
        PptDoc.Slides(4).Shapes.PasteSpecial ppPasteDefault 'ppPasteEnhancedMetafile
 
        NbShpe = PptDoc.Slides(4).Shapes.Count
 
        With PptDoc.Slides(4).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 224
            .Top = 290
            .Height = 77
            .Width = 480
 
        End With
 
 
            ThisWorkbook.Worksheets("SUIVI DES VALIDATIONS").Range("C41:O46").Copy
 
        PptDoc.Slides(5).Shapes.PasteSpecial ppPasteDefault 'ppPasteEnhancedMetafile
 
        NbShpe = PptDoc.Slides(5).Shapes.Count
 
        With PptDoc.Slides(5).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 224
            .Top = 290
            .Height = 77
            .Width = 480
 
        End With
 
 
           ThisWorkbook.Worksheets("SUIVI DES REFUS").Range("C41:O46").Copy
 
        PptDoc.Slides(6).Shapes.PasteSpecial ppPasteDefault 'ppPasteEnhancedMetafile
 
        NbShpe = PptDoc.Slides(6).Shapes.Count
 
        With PptDoc.Slides(6).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 224
            .Top = 290
            .Height = 77
            .Width = 480
 
        End With
 
            ThisWorkbook.Worksheets("SUIVI DES RETARDS").Range("C41:O46").Copy
 
        PptDoc.Slides(7).Shapes.PasteSpecial ppPasteDefault 'ppPasteEnhancedMetafile
 
        NbShpe = PptDoc.Slides(7).Shapes.Count
 
        With PptDoc.Slides(7).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 224
            .Top = 290
            .Height = 77
            .Width = 480
 
        End With
 
 
 
    'PptDoc.Save 'sauvegarder les modifications
    'PptDoc.Close 'fermer le document ppt
    'PPT.Quit 'fermer l'application powerPoint
 
End Sub


Cordialement

Rabik33