Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1680to1684
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

PowerPoint aus Excel speichern

PowerPoint aus Excel speichern
19.03.2019 16:39:17
Jonas
Hallo zusammen,
ich möchte gerne mit VBA aus Excel gewisse Seiten einer Powerpoint speichern. Die Vorgabe, welche Slides gespeichert werden sollen, stehen in einer Zelle, die ausgelesen werden soll.
Wie ich PPT öffne, habe ich schon herausgefunden. Meine Frage ist, wie kann ich das Feld (siehe Anhang) befüllen kann, sodass nur einzelne Slides gespeichert werden.
Bsp: 1-4, 5, 7, 10-25
Als zusätzliche Frage hätte ich, dass ich die Datei gerne sowohl als pptx sowie als pdf gespeichert haben möchte.
Vielen Dank schon mal.
Userbild

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: PowerPoint aus Excel speichern
24.03.2019 15:11:11
fcs
Hallo Jonas,
in deinem Fall öffnet man die PP-Datei am besten schreibgeschützt. dann speichert man sie unter einem neuen Namen, löscht die nicht benötigten Folien, speichert die Datei und speichert dann als PDF.
sieht as Makro dann etwa wie folgt aus.
Gruß
Franz
Sub PP_Auszug_speichern_pdf()
Dim ppApp As Object ' As PowerPoint.Application
Dim ppPre As Object ' As PowerPoint.Presentation
Dim sPP_Datei As String
Dim iSlide As Integer
Dim arrSave() As Boolean
Dim arrPrint, intJ As Integer
With Worksheets("Tabelle1").Range("B3") 'Blattname und Zelle anpassen!!!
If Trim(.Text) = "" Then
MsgBox "in Zelle """ & .Address & """ sind keine Folien-Bummern angegeben!"
Exit Sub
Else
arrPrint = Split(.Text, ",")
End If
End With
Set ppApp = VBA.CreateObject("Powerpoint.Application")
'PowerPoint-Datei schreibgeschützt öffnen
sPP_Datei = "C:\Users\Public\ppPowerPointTest.pptx" 'Pfad, Dateiname anpassen !!!
Set ppPre = ppApp.Presentations.Open(Filename:=sPP_Datei, ReadOnly:=msoTrue)
'geöffnete Datei unter neuem Namen speichern
With ppApp.FileDialog(msoFileDialogSaveAs)
.Title = "Bitte Dateinamen für neue Präsentation eingeben/wählen"
.FilterIndex = 1
If .Show = -1 Then
'speichern im pptx-Format
ppPre.SaveAs Filename:=.SelectedItems(1), FileFormat:=24 ' _
ppSaveAsOpenXMLPresentation
Else
Exit Sub
End If
End With
'eingegebene Folien-Nummern und Bereiche aufbereiten - Paare 1.;letzte Folie bilden
For intJ = 0 To UBound(arrPrint)
'leerzeichen entfernen
arrPrint(intJ) = VBA.Replace(arrPrint(intJ), " ", "")
If InStr(arrPrint(intJ), "-") > 0 Then
'Bindestrich durch Semikolon ersetzen
arrPrint(intJ) = VBA.Replace(arrPrint(intJ), "-", ";")
Else
'einzelne Foliennummern inkl. Semikolon wiederholen
arrPrint(intJ) = arrPrint(intJ) & ";" & arrPrint(intJ)
End If
Next
'zu speichernde Folien in Array markieren
ReDim arrSave(1 To ppPre.Slides.Count)
For intJ = 0 To UBound(arrPrint)
For iSlide = 1 To ppPre.Slides.Count
If iSlide >= Val(Split(arrPrint(intJ), ";")(0)) _
And iSlide 

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige