AW: Ein Ansatz...
01.09.2015 14:36:09
Michael
Hallo Senseye!
Puh, das ist doch schwieriger als ich dachte; ich mache nicht allzu viel hinsichtlich Excel zu PowerPoint und dachte ich kann hier schnell was basteln, aber dem ist nicht so - liegt sicher auch daran, dass mein PowerPoint VBA schwächer ausgeprägt ist als mein Excel VBA.
Dennoch... Einige Deiner Angaben waren widersprüchlich, zB:
Folien 1,3,5,8,10,11 sollen jeweils nur ein Diagramm haben
Folien 2,4,6 sollen 2 Diagramme pro Folie haben
Folie 9 soll 4 Diagramme haben
Das wären insgesamt 16 Diagramme; Du meintest aber in der Excel-Mappe sind insgesamt 15 Diagramm-Blätter. Außerdem war hier nicht klar ob die Foliennummer auch gleich der Diagramm-Nummer sein soll, also auf Folie 1 Diagramm 1 einfügen, auf Folie 3 Diagramm 3 einfügen usw. usf. Das müsstest Du für Dich zunächst definieren. Beachte hierbei: Deine Diagramm-Blätter sind, gem. ihrer Position in der Excel-Arbeitsmappe, von links nach rechts nummeriert. D.h. hast Du 15 Diagramm-Blätter ist das rechteste Diagramm-Blatt Chart(15).
Zu Deinen Foliennummern/Diagramm-Verteilung ist mir aktuell keine schlaue Idee für eine Schleife eingefallen, d.h. das Makro wird entsprechend lang, da alles in Einzelschritten passiert. Auch könnte man natürlich überlegen, ob man bspw. das Anordnen der Bilder auf den Folien in eine eigene Prozedur auslagert... Das ist dann aber sehr aufwändig. Deshalb...
Hier einmal ein Ansatz für Dich, den müsstest Du noch auf Deine Bedingungen erweitern - es ist je ein Abschnitt im Makro als Bsp gedacht um 1 Diagramm/Chart, 2 Diagramme/Charts bzw. 4 Diagramme/Charts jeweils auf eine bestimmte Folie als Bild zu übertragen und anzuordnen. Das ließe sich so oft wiederholen (=jeweiligen Abschnitt kopieren und im Makro hinzufügen), wie Du es brauchst. Anpassen musst Du auf jeden Fall den Dateipfad und -namen der PowerPoint-Präsentation sowie die jeweilige Diagramm-Blatt-Nummer bzw. Foliennummer. Das Makro ist soweit kommentiert, ich hoffe Du findest Dich zurecht. Wichtig ist v.a. auch den Verweis auf die PowerPoint Object Library zu setzen (s. Kommentar)
Sub DiverseChartsNachPowerPoint()
' Verweis auf PowerPoint Object Library erforderlich:
' im VB-Editor über Extras > Verweise > Microsoft PowerPoint 14.0 Object Library
' Häkchen setzen
Dim PoPt As Object
Dim PpDatei As Object
Dim Praes As String
Praes = "C:\... \Präs.pptx" 'Pfad und Name der Präsentation
Set PoPt = CreateObject("Powerpoint.Application")
PoPt.Visible = True ' Powerpoint sichtbar
Set PpDatei = PoPt.Presentations.Open(Praes) 'Präsentation öffnen
PoPt.ActiveWindow.ViewType = ppViewSlide 'Folienansicht einstellen
' 1 Chart auf 1 Folie als Bild übertragen
Charts(1).CopyPicture 'Chart 1 (als Chart-Blatt!)
PoPt.ActivePresentation.Slides(1).Select 'Folie 1
PoPt.ActiveWindow.View.Paste 'Bild einfügen
' Aktuelles Bild (= ausgewählt durch Einfügen) auf Folie anordnen
PoPt.ActiveWindow.Selection.ShapeRange.Left = 184.154
PoPt.ActiveWindow.Selection.ShapeRange.Top = 155.991
PoPt.ActiveWindow.Selection.ShapeRange.Width = 350
' 2 Charts auf 1 Folie als Bild übertragen
Charts(2).CopyPicture ' Chart 2 (als Chart-Blatt!)
PoPt.ActivePresentation.Slides(2).Select ' Folie 2
PoPt.ActiveWindow.View.Paste ' Bild einfügen
' Aktuelles Bild (= ausgewählt durch Einfügen) auf Folie anordnen
PoPt.ActiveWindow.Selection.ShapeRange.Left = 19.08858
PoPt.ActiveWindow.Selection.ShapeRange.Top = 167.9414
PoPt.ActiveWindow.Selection.ShapeRange.Width = 342.9902
Charts(3).CopyPicture ' Chart 3 (als Chart-Blatt!)
PoPt.ActivePresentation.Slides(2).Select ' Folie 2
PoPt.ActiveWindow.View.Paste 'Bild einfügen.Paste
' Aktuelles Bild (= ausgewählt durch Einfügen) auf Folie anordnen
PoPt.ActiveWindow.Selection.ShapeRange.Left = 363.9921
PoPt.ActiveWindow.Selection.ShapeRange.Top = 167.9414
PoPt.ActiveWindow.Selection.ShapeRange.Width = 342.9902
' 4 Charts auf 1 Folie als Bild übertragen
'Diagramm 4, 5, 6, 7 auf Folie 3
Charts(4).CopyPicture ' Chart 4 (als Chart-Blatt!)
PoPt.ActivePresentation.Slides(3).Select ' Folie 3
PoPt.ActiveWindow.View.Paste ' Bild einfügen
' Aktuelles Bild (= ausgewählt durch Einfügen) auf Folie anordnen
PoPt.ActiveWindow.Selection.ShapeRange.Left = 17.00976
PoPt.ActiveWindow.Selection.ShapeRange.Top = 92.4911
PoPt.ActiveWindow.Selection.ShapeRange.Width = 342.9902
Charts(5).CopyPicture ' Chart 5 (als Chart-Blatt!)
PoPt.ActivePresentation.Slides(3).Select ' Folie 3
PoPt.ActiveWindow.View.Paste ' Bild einfügen
' Aktuelles Bild (= ausgewählt durch Einfügen) auf Folie anordnen
PoPt.ActiveWindow.Selection.ShapeRange.Left = 360
PoPt.ActiveWindow.Selection.ShapeRange.Top = 92.4911
PoPt.ActiveWindow.Selection.ShapeRange.Width = 342.9902
Charts(6).CopyPicture ' Chart 6 (als Chart-Blatt!)
PoPt.ActivePresentation.Slides(3).Select ' Folie 3
PoPt.ActiveWindow.View.Paste ' Bild einfügen
' Aktuelles Bild (= ausgewählt durch Einfügen) auf Folie anordnen
PoPt.ActiveWindow.Selection.ShapeRange.Left = 17.00976
PoPt.ActiveWindow.Selection.ShapeRange.Top = 314.3366
PoPt.ActiveWindow.Selection.ShapeRange.Width = 342.9902
Charts(7).CopyPicture ' Chart 7 (als Chart-Blatt!)
PoPt.ActivePresentation.Slides(3).Select ' Folie 3
PoPt.ActiveWindow.View.Paste ' Bild einfügen
' Aktuelles Bild (= ausgewählt durch Einfügen) auf Folie anordnen
PoPt.ActiveWindow.Selection.ShapeRange.Left = 360
PoPt.ActiveWindow.Selection.ShapeRange.Top = 314.3366
PoPt.ActiveWindow.Selection.ShapeRange.Width = 342.9902
PoPt.ActiveWindow.ViewType = ppViewNormal ' Powerpoint-Ansicht "Normal"
PoPt.ActivePresentation.Save ' Powerpoint-Präsentation speichern
PoPt.Activate ' Powerpoint anzeigen
End Sub
Hoffe damit kannst Du mal arbeiten! Um Herauszufinden wie die Bildpositionen eingerichtet werden sollen (s. o. im Code .ShapeRange.Left, .Top, .Width) füge manuell ein Diagramm als Bild in PowerPoint ein und richte es so ein, wie Du es haben möchtest; danach direkt mit Alt + F11 in die PowerPoint VB-Umgebung wechseln und mit diesem Makro die Werte auslesen (im Direktfenster unten) - die kannst Du dann in Dein Excel-Makro übernehmen:
Sub BildPosition()
Dim i
Dim j
Dim k
i = PowerPoint.Application.ActiveWindow.Selection.ShapeRange.Left
j = PowerPoint.Application.ActiveWindow.Selection.ShapeRange.Top
k = PowerPoint.Application.ActiveWindow.Selection.ShapeRange.Width
Debug.Print i, j, k
End Sub
LG
Michael