Loop to insert PowerPoint title with VBA for 10 slides

Question

I saw this code in StackOverflow that inserts a title in one slide.

Sub add_title()

Dim shpCurrShape As Shape
Dim ppPres As Presentation

Set ppPres = ActivePresentation

With ActivePresentation.Slides.Range(Array(1, 2, 3, 4, 5))

    If Not .Shapes.HasTitle Then
        Set shpCurrShape = .Shapes.AddTitle
    Else
        Set shpCurrShape = .Shapes.Title
    End If

    With shpCurrShape
        With .TextFrame.TextRange
            '~~> Set text here
            .Text = "BLAH BLAH"
            '~~> Alignment
            .ParagraphFormat.Alignment = 1
            '~~> Working with font
            With .Font
                .Bold = msoTrue
                .Name = "Tw Cen MT"
                .Size = 24
                .Color = RGB(0, 0, 0)
            End With
        End With
    End With
End With
End Sub

I would like to add the same slide title for a given number of slides, for example, the first ten slides.

I understand it can be done with a loop, selecting the range of the slides of interest.

Also, how would I define the array for indicating slides 20 to 30?

Answer 1

I would move the decision over which slides to change to a different sub, then call add_title only to those slides you wish to change.

Sub AddTitles()
    Dim i As Long
    For i = 20 to 30
        add_title i
    Next i
End Sub

Sub add_title(ByVal slideNumber As Long)
    Dim ppPres As Presentation
    Set ppPres = ActivePresentation

    With ppPres.Slides(slideNumber)
        Dim shpCurrShape As Shape
        If Not .Shapes.HasTitle Then
            Set shpCurrShape = .Shapes.AddTitle
        Else
            Set shpCurrShape = .Shapes.Title
        End If

        With shpCurrShape
            With .TextFrame.TextRange
                '~~> Set text here
                .Text = "BLAH BLAH"
                '~~> Alignment
                .ParagraphFormat.Alignment = 1
               '~~> Working with font
               With .Font
                  .Bold = msoTrue
                  .Name = "Tw Cen MT"
                  .Size = 24
                  .Color = RGB(0, 0, 0)
               End With
            End With
        End With
    End With
End Sub