Skip to content

Instantly share code, notes, and snippets.

@foreachthing
Last active November 19, 2018 07:48
Show Gist options
  • Save foreachthing/20da89637debd38b53799ef6aa6081c9 to your computer and use it in GitHub Desktop.
Save foreachthing/20da89637debd38b53799ef6aa6081c9 to your computer and use it in GitHub Desktop.
Split PowerPoint Presentation into single PDF files
Option Explicit
Public Sub SplitPresentation2PDF()
Dim CurrentPres As Presentation
Dim strPath As String
Dim strExtension As String
Dim strFileName As String
Dim iNumOfSlides As Long
Dim i As Long
Dim strFormat As String
Dim strSplitName As String
Dim icurrentslide As Long
On Error GoTo ErrorHandler
Set CurrentPres = ActivePresentation
strPath = ActivePresentation.path & "\"
strExtension = "pdf"
strFileName = Left(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") - 1)
iNumOfSlides = CurrentPres.Slides.Count
strFormat = getStringFormat(iNumOfSlides)
icurrentslide = ActiveWindow.Selection.SlideRange.SlideIndex
For i = 1 To iNumOfSlides
strSplitName = strPath & strFileName & "_" & Format$(i, strFormat) & "." & LCase(strExtension)
If LCase(strExtension) <> "pdf" Then
CurrentPres.Slides(i).Export strSplitName, UCase(strExtension)
Else
CurrentPres.Slides(i).Select
CurrentPres.ExportAsFixedFormat strSplitName, ppFixedFormatTypePDF, ppFixedFormatIntentPrint, msoFalse, ppPrintHandoutHorizontalFirst, ppPrintOutputSlides, msoFalse, , ppPrintCurrent
End If
Next
GoTo Success
Success:
CurrentPres.Slides(icurrentslide).Select
Exit Sub
ErrorHandler:
If Err <> 0 Then
MsgBox Err.Description
End If
End Sub
Private Function getStringFormat(i As Long)
getStringFormat = String(Len(str(i) - 1), "0")
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment