Export PowerPoint to individual PDFs with named sections. X.pptx --> X_Section1.pdf, X_Section2.pdf

Export.pptm

Sub ExportSectionsToPDF()
    Dim pptPresentation As Presentation
    Dim tmpPresentation As Presentation
    Dim slideCount As Integer
    Dim i As Integer
    Dim sectionCount As Integer
    Dim sectionName As String
    Dim sectionStart As Integer
    Dim filePath As String
    Dim baseFileName As String
    
    ' Initialize PowerPoint presentation object
    Set pptPresentation = Application.ActivePresentation
    
    slideCount = pptPresentation.Slides.Count
    sectionCount = pptPresentation.SectionProperties.Count
    sectionStart = 1
    
    ' Extract the base file name from the presentation name
    baseFileName = Replace(pptPresentation.Name, ".pptx", "")
    
    ' Loop through slides to find new sections
    For i = 1 To sectionCount
        sectionName = pptPresentation.SectionProperties.Name(i)
        sectionStart = pptPresentation.SectionProperties.FirstSlide(i)
        Dim nextSectionStart As Integer
        If i < sectionCount Then
            nextSectionStart = pptPresentation.SectionProperties.FirstSlide(i + 1) - 1
        Else
            nextSectionStart = slideCount
        End If
        
        ' Create a temporary presentation
        Set tmpPresentation = Presentations.Add

        ' Copy slides from section to temporary presentation
        For j = sectionStart To nextSectionStart
            pptPresentation.Slides(j).Copy
            tmpPresentation.Slides.Paste
        Next j

        ' Generate file name
        filePath = pptPresentation.Path & "\" & baseFileName & "_" & sectionName & ".pdf"
        
        ' Export to PDF
        tmpPresentation.ExportAsFixedFormat filePath, ppFixedFormatTypePDF
        
        ' Close the temporary presentation without saving
        tmpPresentation.Close
    Next i

    ' Release objects
    Set pptPresentation = Nothing
    Set tmpPresentation = Nothing
End Sub