Sub
excel_to_pp()
Dim
strPPTX
As
String
Dim
strPfad
As
String
Dim
pptVorlage
As
String
Dim
pptApp
As
Object
Dim
pptPres
As
Presentation
strPfad = "C:\Users\A49966070\Desktop\Reporting VBA\"
strPPTX =
"cockpit_vorlage.pptx"
Set
pptApp =
New
PowerPoint.Application
pptApp.Visible =
True
pptVorlage = strPfad & strPPTX
pptApp.Presentations.Open Filename:=pptVorlage, untitled:=msoTrue
Set
pptPres = pptApp.ActivePresentation
Workbooks(
"Testdatei.xlsm"
).Sheets(
"Workload_Eingang"
).ChartObjects(
"Mittelwert"
).CopyPicture xlScreen, xlPICT
pptPres.Slides(2).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Workbooks(
"Testdatei.xlsm"
).Sheets(
"Forecast"
).ChartObjects(
"F_SBU"
).CopyPicture xlScreen, xlPicture
pptPres.Slides(8).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
End
Sub