Flexible Slide Numbering

PPTools
Shape Styles brings the power of styles to PowerPoint. Apply complex formatting with a single click
Merge Excel, CSV or tab-delimited data into PowerPoint presentations to create certificates, awards presentations, personalized presentations and more
FixLinks prevents broken links when you distribute PowerPoint presentations
Optimizer saves disk space and bandwidth, shrinks your PowerPoint presentations to the right size for email, screenshow or printing
PPT2HTML gives you full control of PowerPoint HTML output, helps meet Section 508 accessibility requirements
Prep4PDF preserves interactivity in PowerPoint presentations when you convert to PDF
Image Export converts PowerPoint slides to JPG, PNG, GIF, WMF and and more

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

Contents © 1995-2008 Stephen Rindsberg, Rindsberg Photography, Inc. and members of the MS PowerPoint MVP team. You may link to this page but any form of unauthorized reproduction of this page's contents is expressly forbidden.

content authoring & site maintenance by

Friday - The Automatic FAQ Maker