Macro VBA Script: Add title text 'Figure 3.X' to all slides in PowerPoint

Sub AddFigureTitleToAllSlides()

    Dim sld As Slide

    Dim shp As Shape

    Dim slideIndex As Integer

    Dim titleSet As Boolean

    For Each sld In ActivePresentation.Slides

        slideIndex = sld.slideIndex

        titleSet = False

        ' Try to find and set the title placeholder if it exists

        For Each shp In sld.Shapes

            If shp.Type = msoPlaceholder Then

                If shp.PlaceholderFormat.Type = ppPlaceholderTitle Then

                    shp.TextFrame.TextRange.Text = "Figure 3." & slideIndex

                    titleSet = True

                    Exit For

                End If

            End If

        Next shp

        ' If no title placeholder, add a textbox at the top

        If Not titleSet Then

            Set shp = sld.Shapes.AddTextbox( _

                Orientation:=msoTextOrientationHorizontal, _

                Left:=50, Top:=20, Width:=600, Height:=50)

            With shp.TextFrame.TextRange

                .Text = "Figure " & slideIndex

                .Font.Size = 28

                .Font.Bold = True

            End With

        End If

    Next sld

    MsgBox "Titles 'Figure X' added to all slides.", vbInformation

End Sub