1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
|
Sub TestPowerPoint()
Dim Xlwkb As Excel.Workbook
Dim Xlwks As Excel.Worksheet
Dim ppt As PowerPoint.Application
Dim Pres As PowerPoint.Presentation
Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = True
Set Pres = ppt.Presentations.Open(Filename:="L:\Presentation1.ppt")
Set Xlwkb = ThisWorkbook
Set Xlwks = Xlwkb.ActiveSheet
Xlwks.Range(Xlwks.Cells(1, 1), Xlwks.Cells(20, 9)).Copy
Pres.Slides(1).Shapes.Paste ppPasteMetafilePicture
Pres.SaveAs ("L:\test.ppt")
ppt.Quit
Set ppt = Nothing
End Sub |
Partager