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