PowerPoint VBA: How to add slides at end of section?

Question

I have two sections in a PowerPoint presentation and want to add a new slide to the end of each section. My code works for the first section but for the second section the new slide is placed at the end of the first section.

Any help how to find a solution for this is much appreciated!

Sub AddSlidesAtEndOfSection()
    Dim PowerPointApp As Object
    Dim myPresentation As Object
    Dim mySlide As Slide
    Dim sldCount As Integer
    Dim SecNum As Integer

    'Create an Instance of PowerPoint
    On Error Resume Next
    Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    Err.Clear

    'If PowerPoint is not already open then open PowerPoint
    If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    
    'Handle PowerPoint Application not found
    If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
    End If
    On Error GoTo 0

    If PowerPointApp.Presentations.Count = 0 Then
        Set myPresentation = PowerPointApp.Presentations.Add
        With myPresentation
            .PageSetup.SlideWidth = 8.5 * 72
            .PageSetup.SlideHeight = 11 * 72
            .SectionProperties.AddSection 1, "section one"
            .SectionProperties.AddSection 2, "section two"
        End With
    Else
        Set myPresentation = PowerPointApp.ActivePresentation
    End If

    '------------->  Add Slide at end of each section <-------------
    For SecNum = 1 To 2
        sldCount = myPresentation.SectionProperties.SlidesCount(SecNum) 
        'add slide
        Set mySlide = myPresentation.Slides.Add(sldCount + 1, ppLayoutBlank)
   
        mySlide.MoveToSectionStart (SecNum)
        With myPresentation.SectionProperties
            SlideCount = .SlidesCount(SecNum)
            FirstSecSlide = .FirstSlide(SecNum)
            mySlide.MoveTo toPos:=FirstSecSlide + SlideCount - 1
        End With
    Next
End Sub

Neoheurist · Answer 1 · 2023-03-07T02:54:39.270

Create the new slide wherever (e.g. at the end of the presenation) and then when the section is empty use MoveToSectionStart() to move the slide into the section or when the section is populated use MoveTo(.FirstSlide(sectionIndex) + .SlidesCount(sectionIndex)) to move the slide to the end of the section:

Sub AddSlideAtEndOfEachSection()
    On Error Resume Next
    Dim application As Object
    Set application = GetObject(class:="PowerPoint.Application")
    Err.Clear

    If application Is Nothing Then Set application = CreateObject(class:="PowerPoint.Application")
    If Err.Number = 429 Then
        MsgBox "[Aborting] PowerPoint application object could not be found or created"
        Exit Sub
    End If
    On Error GoTo 0

    Dim presentation As Object
    If 0 = application.Presentations.Count Then
        Set presentation = application.Presentations.Add
        With presentation
            .PageSetup.SlideWidth = 8.5 * 72
            .PageSetup.SlideHeight = 11 * 72
            .SectionProperties.AddSection 1, "section one"
            .SectionProperties.AddSection 2, "section two"
        End With
    Else
        Set presentation = application.ActivePresentation

        ' We might want to validate that the expected sections exist
        ' and if not create these or fail, as per requirements, e.g.
        ' If 2 > presentation.SectionProperties.Count Then ...
    End If

    Dim sectionIndex As Integer
    For sectionIndex = 1 To 2
        Dim slide as Slide
        With presentation.SectionProperties
            slide = presentation.Slides.AddSlide(presentation.Slides.Count, ppLayoutBlank)
            If 0 = .SlidesCount(sectionIndex) Then
                slide.MoveToSectionStart(sectionIndex)
            Else
                slide.MoveTo(.FirstSlide(sectionIndex) + .SlidesCount(sectionIndex))
            End If
        End With
    Next sectionIndex
End Sub

PowerPoint VBA: How to add slides at end of section?

1 Answers1