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
|
Sub Sample()
Dim oPPApp As Object, oPPPrsn As Object
Dim oPPSlide As Object, oPPShape As Object
Dim FlName As String
Dim chartNum As Long
'~~> Change this to the relevant file
FlName = "C:\myFile.ppt"
'~~> Establish an PowerPoint application object
On Error Resume Next
Set oPPApp = GetObject(, "PowerPoint.Application")
If Err.Number <> 0 Then
Set oPPApp = CreateObject("PowerPoint.Application")
End If
Err.Clear
On Error GoTo 0
oPPApp.Visible = True
'~~> Open the relevant powerpoint file
Set oPPPrsn = oPPApp.Presentations.Open(FlName)
'~~> Change this to the relevant slide which has the shape
Set oPPSlide = oPPPrsn.Slides(7)
'~~> This is the shape which will be replaced
Set oPPShape = oPPSlide.Shapes("Picture 15")
oPPShape.Delete
chartNum = 1
ThisWorkbook.Sheets("Feuil2").ChartObjects(chartNum).Copy
Set oPPShape = oPPSlide.Shapes.PasteSpecial(DataType:=10, Link:=msoFalse)
oPPShape.Name = "MyShape"
End Sub |
Partager