Bonjour

je cherche à copier des graphiques Excel vers Powerpoint par macros

j'arrive à le copier mais les données restent liées à la feuille Excel

je voudrais que chaque graphique soit indépendant de la feuille Excel (données incorporées dans le fichier PPT)

j'arrive à faire la copie à la main en choisissant "collage spécial incorporer le fichier Excel", mais je n'arrive pas à trouver le code VBA pour le faire (même en enregistrant la macro manuellement)

Si quelqu'un connaît l'option pour le code VBA, ça me ferait gagner un temps fou

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
Sub NouvellePresentation()
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim nbshpe As Integer
Dim Gr As Workbook
 
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add
 
With PptDoc
 
.Slides.Add Index:=1, Layout:=ppLayoutBlank
 
Set Sh = .Slides(1).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
Left:=100, Top:=100, Width:=150, Height:=60)
 
 
Sh.TextFrame.TextRange.Text = Range("A1")
 
Sh.TextFrame.TextRange.Font.Color = RGB(255, 100, 255)
 
Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
 
'copie le 1er graphique contenu dans la feuille Excel active
 
Diapo.Shapes.PasteSpecial
 
'=================================================
'=================================================
'j'ai teste avec les options de PAsteSPecial et je ne trouve pas
 
'================================================
'================================================
 
 
nbshpe = Diapo.Shapes.Count
 
End With
 
With Diapo.Shapes(nbshpe)
.Name = "monGraph" 'personnalise le nom
.Left = 150 'définit la position horizontale dans le slide
.Top = 100 'définit la position verticale dans le slide
.Height = 300 'hauteur
.Width = 400 'largeur
End With
 
PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "Eddie.pptx"
PptDoc.Close
PptApp.Quit
 
End Sub
merci !

Eddie