PowerPoint - Shapes aus Template kopieren

Wer viele Präsentationen mit Microsoft PowerPoint baut, kennt das: Ein gutes Folienlayout kann immer wieder verwendet werden. Sei es eine bestimmte Anordnung von Shapes und Textboxen (wie der Klassiker "Zweispalter" mit Überschriften, Textboxen, einem Pfeil) oder schön formatierte Tabellen.

Hierzu bietet es sich an die gewünschten Slide-Layouts in einer Datei (bspw. Templates.pptx) abzuspeichern. In dieser Datei sollten auf den Folien jeweils nur die zu kopierenden Shapes/Elemente vorhanden sein, d.h. kein Titel o.ä. auf den Slides. Mit einem einfachen Makro (getShapesFromTemplate) können nun die Elemente jeweils von einer bestimmten Seite (Parameter fromSlide) im Template auf die aktuelle Seite in der gerade geöffneten Präsentation kopiert werden:

Private Sub getShapesFromTemplate(fromSlide As Long)
    Dim presentationWithTemplates As Presentation

    Set presentationWithTemplates = Application.Presentations.Open("PFAD-JEWEILS-ANZUPASSEN/Templates.pptx", msoCTrue, msoFalse)

    presentationWithTemplates.Slides(fromSlide).Shapes.Range.Copy
    presentationWithTemplates.Close
    Set presentationWithTemplates = Nothing

    ActiveWindow.View.Slide.Shapes.Paste

End Sub

Public Sub getShapes1()
    getShapesFromTemplate (1)
End Sub

Public Sub getShapes2()
    getShapesFromTemplate (2)
End Sub

Der Aufruf erfolgt dann wie im Beispiel gezeigt über weitere öffentliche Funktionen (im Bespiel getShapes1 und getShapes2). Diese können dann für den schnellen Zugriff bspw. auf Schaltflächen oder Ribbon-Elemente gelegt werden.

Templates.pptx: Bildschirmfoto 2018-09-19 um 21.48.24.png

Shapes einfügen per Makro: Bildschirmfoto 2018-09-19 um 21.59.53.png Bildschirmfoto 2018-09-19 um 22.00.56.png

Noch ein paar Hintergründe (für die Interessierten):

  • Die gezeigte Fassung des Macros hat noch kein Error-Handling, so dass Fehler (bspw. Anforderung einer nicht vorhandenen Slide, falscher Pfad für die Datei, usw.) noch nicht abgefangen werden
  • Die Vorlage ist notwendig, da PowerPoint keine Objekte/Shapes per Macro serialisieren und wieder einfügen kann. Die Alternative wäre jede Eigenschaft eines Objektes einzeln auszulesen, zu speichern und dann neue Objekte auf Basis der Werte wieder per VBA zu erzeugen. Im Vergleich ist dann Copy&Paste per Makro einfacher

This article is my 2nd oldest. It is 278 words long