TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

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