Graphik von Excel in PPT - bricht ab bei Einfügen
15.04.2014 13:01:49
Excel
nachdem ich jetzt alle Foren im Internet durch bin, bleibt mein Makro immer noch hängen. Ich möchte Graphiken von excel in ein bestehendes PPT kopieren, per Makro.
Es funktioniert alles : PPT auf, Datei auf, Excel Graph kopieren, richtige Seite in PPT, aber dann fügt er es nicht ein. In der ZW-Ablage ist es, denn wenn ich mit Rechts-klick einfüge, ist es da. (Verweis auf PPT ist auch gesetzt, wenn VBA zu ist, gehts auch nicht). Ich hoffe es kann mir jemand helfen.
Hier der code:
Sub PPTGraphiken()
Dim pptApp As Object, pptPres As Object, pptSlide As Object
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Open("C:\Users\Template1.pptx")
'oeffnet bestehende .ppt-Vorlage
pptApp.ActivePresentation.Slides(1).Select
'Copy chart aus excel
Sheets("Graphik-Märkte-Retail").Select
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.ChartArea.Copy
'Test ob copy in ZW-ablage vohanden -funktioniert
'Workbooks.Add
'Range("B5").Select
'ActiveSheet.PasteSpecial Format:="Bild (Erweiterte Metadatei)", Link:=False _
, DisplayAsIcon:=False
'paste in PPT
pptApp.ActivePresentation.Slides(3).Select
'hier bricht es ab
pptApp.ActiveWindow.View.PasteSpecial Format:="Bild (Erweiterte Metadatei)", Link:=False _
, DisplayAsIcon:=False
With pptApp.ActiveWindow
.Selection.ShapeRange.Left = 110
.Selection.ShapeRange.Top = 100
.Selection.ShapeRange.Width = 500
.Selection.ShapeRange.Height = 400
End With
End Sub