Microsoft Excel

Herbers Excel/VBA-Archiv

Excel-Dias in Powerpoint per VBA | Herbers Excel-Forum


Betrifft: Excel-Dias in Powerpoint per VBA von: kruemelcookie
Geschrieben am: 02.12.2009 09:46:29

Hallo zusammen,

ich verfolge schon seit einigen Wochen verschiedenste Threads im Internet zum oben genannten Thema, da ich genau einen solchen Link herstellen will.
Leider kenn ich mich mit dem Thema Makros noch nicht so gut aus, und hab daher verschiedenste Schnippsel zusammenkopiert, geändert, probiert, geändert, gesucht, probiert etc.

Nun komm ich aber leider nicht weiter. Hier mein Problem, in der Hoffnung dass mir jemand helfen kann:

Ich habe eine Exceldatei mit mehreren Worksheets. Eins davon ist ein Übersichtsblatt auf dem sich Graphiken und Schaltflächen befinden, die Schaltflächen blenden per Makro andere Worksheets ein und aus, die bearbeitet werden können und die Graphiken auf der Übersicht aktualisieren.
Jetzt möchte ich meine Graphiken aus der Übersicht nach Powerpoint haben und zwar eine Graphik pro Folie.
Auf meiner Übersicht befinden sich Graphiken in Form von Zellen (z.B. A1:F15) oder auch Diagramme, die ich dort abgelegt habe.

Die erste Form kann inzwischen per VBA nach Powerpoint transferieren. Nur bei den eingebetteten Diagrammen hapert es derzeit. Momentan habe ich drei eingebettete Diagramme auf dem Übersichtsblatt und mein aktueller Makro kopiert diese auch nach Powerpoint auf Folie 4, nur dass er für jede Graphik eine PPT öffnet, statt alle Graphiken in EINER PPT hintereinander auf Folien zu packen.
Und hier hänge ich derzeit fest.

Ich poste mal den VBA Code:

Sub ChartObjectsNachPowerpoint()
' Kopiere Diagramm Beinnaheunfälle in Powerpoint
Dim pptApp As Object
Dim pptPres As Object
Dim chtObj As Object
Dim shp As Object
 'Dateiname
PPPres = "D:\Test.ppt"
    'Object referenzieren
Set PPApp = CreateObject("Powerpoint.Application")
For Each chtObj In ActiveSheet.ChartObjects
chtObj.Chart.ChartArea.Copy
'Object initialisieren
    PPApp.Visible = msoTrue
    'PPT öffnen
    Set ppFile = PPApp.Presentations.Open(PPPres)
    'Foliennummer angeben
    PPApp.ActivePresentation.Slides(4).Select
    'Bereich einfügen und OLE Verknüpfung herstellen = Link
    With PPApp.ActiveWindow
        .ViewType = ppViewSlide
        .View.PasteSpecial DataType:=ppPasteDefault, link:=msoTrue
    End With
    'Eingefügte Tabelle skalieren
    With PPApp.ActiveWindow.Selection.ShapeRange
        'Oberer Rand 1 cm unter Standardtitel
        .Top = 120
        'Linker Rand 1.5 cm von linkem Folienrand
        .Left = 180
        'Eingefügte Tabelle auf Links und rechts 1,5 cm Rand skalieren
        .Width = 650
        'Bei Bedarf Höhe noch einstellen
        'Hier ist jedoch zu beachten, dass das Object skaliert wird !!!
        'Die Breite verändert sich dann
        .Height = 300
    End With
    Next
    pptApp.Visible = True
End Sub
Soweit. Achja, und bei
pptApp.Visible = True 

hängt er sich auch auf!

Ich hatte es auch probiert, statt eingebetteter Diagramme, diese als Worksheet abzulegen, aber auch das hab ich bisher nicht hingekriegt.

Weiß jemand Rat?

  

Betrifft: AW: Excel-Dias in Powerpoint per VBA von: fcs
Geschrieben am: 02.12.2009 15:27:11

Hallo Kruemelcookie,

MS Powerpoint ist von Excel aus nicht so einfach zu handhaben.

Ich hab deine Prozedur mal ein wenig bezüglich Reihenfolge der Aktionen bereinigt und die Objektwelt aufbereitet.
In meinem Beispiel werden 3 Chart-Objekte an PP übergeben, hier muss du die Zählung der Slide ind die Chart-Objekte eingefügt werden entsprechend anpassen. in der PPDatei müssen schon entsprechend viele Leerfolien vorhanden sein, sonst crashed das Makro.

Bei läuft das Makro sehr langsam an, bis endlich die PowerPoint-Anwendung gestarte ist.

Gruß
Franz

Sub ChartObjectsNachPowerpoint()
' Kopiere Diagramm Beinnaheunfälle in Powerpoint
'Im Excel VBA-Editor für die Datei den Verweis auf die _
      Microsoft Powerpoint object Library aktivieren
  Dim pptApp As PowerPoint.Application
  Dim ppFile As PowerPoint.Presentation, PPPres As String
  Dim chtObj As Excel.ChartObject
  Dim pptShape As PowerPoint.Shape
  Dim pptSlide As PowerPoint.Slide
  Dim intFolieNr As Long, arrFoliennummer, strPP_Neu As Variant
 'Dateiname
    PPPres = "D:\Test.ppt"
    PPPres = "C:\Lokale daten\Test\Test01.ppt"
    'Object referenzieren
    Set pptApp = CreateObject("Powerpoint.Application")
    pptApp.Visible = msoTrue
    'PPT schreibgeschützt öffnen
    Set ppFile = pptApp.Presentations.Open(PPPres, msoTrue)
    
    'Liste und Reihenfolge der Slide-Nummern in die Grafiken eingefügt werden sollen
    arrFoliennummer = Array(4, 5, 6)
    intFolieNr = LBound(arrFoliennummer) - 1
    'Ansicht in PP so einstellen, das Objekte in PP eingefügt werden können
    With pptApp.ActiveWindow
        .ViewType = ppViewSlide
    End With
    '3 Diagramm-Objekte vom aktiven Blatt in PP-Präsentation einfügen
    For Each chtObj In ActiveSheet.ChartObjects
      chtObj.Chart.ChartArea.Copy
      'Object initialisieren
        'Foliennummer angeben
        intFolieNr = intFolieNr + 1
        Set pptSlide = ppFile.Slides(arrFoliennummer(intFolieNr))
        pptSlide.Select
        'Bereich einfügen und OLE Verknüpfung herstellen = Link
        With pptApp.ActiveWindow
            .View.PasteSpecial DataType:=ppPasteDefault, link:=msoTrue
        End With
        Set pptShape = pptSlide.Shapes(pptSlide.Shapes.Count)
        'Eingefügtes Objekt skalieren
        With pptShape
            'Oberer Rand 1 cm unter Standardtitel
            .Top = 120
            'Linker Rand 1.5 cm von linkem Folienrand
            .Left = 180
            'Eingefügte Tabelle auf Links und rechts 1,5 cm Rand skalieren
            .Width = 650
            'Bei Bedarf Höhe noch einstellen
            'Hier ist jedoch zu beachten, dass das Object skaliert wird !!!
            'Die Breite verändert sich dann
            .Height = 300
        End With
    Next
    pptApp.Visible = True
    
    'Excel anzeigen für Dialog-Speichern-Name
    Application.Visible = True
    strPP_Neu = Application.GetSaveAsFilename(InitialFileName:=ppFile.Path & Application. _
PathSeparator _
          & "TestPP01.ppt", Filefilter:="Powerpoint (*.ppt),*.ppt", _
          Title:="Bitte Namen für neue PowerPoint Datei wählen/eingeben")
    If strPP_Neu <> False Then
        ppFile.SaveAs Filename:=strPP_Neu
        ppFile.Close
        pptApp.Quit
    End If
    'Objektvariablen aufräumen
    Set chtObj = Nothing
    Set pptSlide = Nothing
    Set ppFile = Nothing
    Set pptApp = Nothing
End Sub



  

Betrifft: AW: Excel-Dias in Powerpoint per VBA von: kruemelcookie
Geschrieben am: 03.12.2009 13:30:46

Hi Franz,

super, vielen Dank, funktioniert wunderbar!
Allerdings eine Sache: irgendwie gefällt mir der Schreibschutz in ppt nicht so wirklich. Wie kann ich den denn im Makro rausnehmen?!
Alles was ich probiert habe, bringt mich immer wieder nur zum Debugger :O)

Danke!


  

Betrifft: AW: Excel-Dias in Powerpoint per VBA von: fcs
Geschrieben am: 03.12.2009 23:07:58

Hallo Kruemelcookie,

in folgender Zeile den Prameter msoTrue weglassen oder auf msoFalse ändern

    Set ppFile = pptApp.Presentations.Open(PPPres, msoTrue)

Gruß
Franz


Beiträge aus den Excel-Beispielen zum Thema "Excel-Dias in Powerpoint per VBA"