VBA - aus Excel individualisierte PPTs
09.10.2021 18:13:26
Kevin
ich verzweifel schon den ganzen morgen und auch die Google Suche bringt mich gerade leider nicht weiter. Ich habe bereits gefühlt alles ausprobiert - aber es muss doch möglich sein?!
Hauptproblem: Ich versuche gerade mehrfach verschiedene Slides aus einer Präsentation in eine andere zu kopieren - es funktioniert auch schon teilweise, allerdings zerschießt es mir aktuell noch immer das Format.
Zusätzliche Kurzbeschreibung: Das Programm ist etwas umfangreicher - es soll bestimmte Slides aus einer bestehenden PPT1 in eine neu erstellt PPT2 kopieren. Diese zu kopierenden Seiten der Slides (Indizes der Slides) werden aus einer Excel extrahiert. Die neue PPT wird unter einem individualisierten Namen - ebenfalls aus der Excel extrahiert - gespeichert. Das ganze soll ca. 400 umfangreiche PPTs individualisiert erstellen.
Dim ActivePres As PowerPoint.Presentation
Dim TargetPres As PowerPoint.Presentation
Dim pp As Object
For i = 2 To matchingTable.Range.Rows.Count + 1
'Teilnehmer XY-Tag für Benennung
tnTag = wb.Sheets(2).Cells(i, 1).Value & "_" & wb.Sheets(2).Cells(i, 2).Value
Debug.Print "Reihe " & i & " lautet: " & wb.Sheets(2).Cells(i, 1).Value & " " & wb.Sheets(2).Cells(i, 2).Value
tnPath = pathFolder & "" & i & "_Teilnehmer_" & tnTag
'Kopieren der Folien aus PPT1 nach neuer PPT
On Error Resume Next
Set pp = GetObject(, "PowerPoint.Application")
If Err.Number 0 Then Set pp = CreateObject("PowerPoint.Application")
On Error GoTo 0
Set ActivePres = pp.ActivePresentation
Set TargetPres = pp.Presentations.Add ' Erstelle neue leere Presentation
'Kopieren der ersten 7 Standardfolien Folien
For j = 1 To 7
ActivePres.Windows(1).Activate
ActivePres.Slides(j).Copy
TargetPres.Windows(1).Activate
'TargetPres.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")
'TargetPres.Slides.Paste
Next
Debug.Print "Kopiere Hotel Seite: " & wb.Sheets(2).Cells(i, 6).Value
'Kopieren der individuellen Hotel-Slide / Hotel Seitenzahl Angabe Spalte 6
'ActivePres.Slides(wb.Sheets(2).Cells(i, 6).Value).Copy
'TargetPres.Slides.Paste
'Speichern der aktuellen Präsentation, sowie Speichern von Duplikaten für jeden Teilnehmer
With TargetPres
' .Save tnPath 'Aktuelle Powerpoint sichern
.SaveCopyAs tnPath 'Speichern als Default (idF. PPT mit Makros)
.Close
End With
'Zurücksetzen der Variablen
Set ActivePres = Nothing
Set TargetPres = Nothing
Set pp = Nothing
Das große Problem liegt bisher in der For-Schleife - Slides werden zwar kopiert, aber in einem anderen Format. Der auskommentierte Befehl "PasteSourceFormatting" funktioniert hier leider irgendwie nicht.
Ich würde mich wirklich sehr über Eure Hilfe freuen.
Liebe Grüße
Sonnix