Flexible Slide Numbering

This handy VBA routine from John Wilson of PowerPoint Alchemy will number your slides consecutively, starting at any slide in the presentation. It gives you the option of skipping Title slides in the numbering sequence.

When asked for a starting number, enter 999 to delete all slide numbers.

Adjust the variable sngLeftPos to change the position of the number on the slide.

Sub Numberme()
'Copyright PowerPoint alchemy
'Numbers consecutively from a start slide but does not number title slides if requested
'enter 999 to remove numbers
On Error GoTo ErrHandler

    Dim lFrom As Long, lTot As Long, lNum As Long, n As Long
    Dim sngLeftpos As Single, strTask As String
    Dim oSld As Slide, oShp As Shape

    lFrom = CInt(InputBox("start numbering from slide ...?"))

    If lFrom <> 999 Then strTask = MsgBox("Number Title layout slides?", vbYesNo)
    lNum = 1

    lTot = ActivePresentation.Slides.Count

    'strip old numbers
    For Each oSld In ActivePresentation.Slides
        For Each oShp In oSld.Shapes
            If oShp.Name = "snumber" Then oShp.Delete
        Next oShp
    Next oSld

    'main routine
    sngLeftpos = 550
    If lFrom = 999 Then Exit Sub

    If lFrom > lTot Then
        MsgBox "You have chosen a start point > than the number of slides!", vbCritical, "Error"
        Exit Sub
    End If

    For n = lFrom To lTot
        With ActivePresentation.Slides(n).Shapes.AddTextbox(msoTextOrientationHorizontal, _
            Left:=sngLeftpos, _
            Top:=500, _
            width:=200, _
            height:=50)

            If strTask = vbNo And ActivePresentation.Slides(n).Layout = ppLayoutTitle Then
                ' don't number the slide but increment the slide number
                ' comment the following line out if you want title slides to be skipped
                ' ie, not to be included in numbering sequence and not numbered 
                lNum = lNum + 1
            Else
                .TextFrame.TextRange.Text = CStr(lNum)
                .Name = "snumber"
                lNum = lNum + 1
            End If
        End With
     Next

    Exit Sub

ErrHandler:
    MsgBox "Sorry there's an error!", vbCritical

End Sub

---