Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1848to1852
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - aus Excel individualisierte PPTs

VBA - aus Excel individualisierte PPTs
09.10.2021 18:13:26
Kevin
Hallo Ihr Lieben,
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - aus Excel individualisierte PPTs
11.10.2021 16:18:42
Yal
Hallo Sonnix,
" ... zerschießt es mir aktuell noch immer das Format."
Ja, so ist es. Anstatt einige Slides rüber zu kopieren, versuche den ganzen PPT auf Dateiebene zu kopieren und dann die nicht benötigte Slides in der neue Version zu entfernen.
Es gibt einige Einstellungen, die nicht auf Slide-Ebene gespeichert werden und somit nicht übertragen werden, wenn Du einzelne Slides in eine neuen PPT mit seinen eigenen Einstellungen einfügst.
VG
Yal

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige