Auto Slide Numbering in MS PowerPoint

A couple of macros for Microsoft Powerpoint XP to achieve correct slide numbering (given the presence of intermittent hidden slides) is available at http://dsl.serc.iisc.ernet.in/~abhi/ppt/Putslidenos.txt or below
under the GPL.

Steps:
1) Open the required presentation in Powerpoint XP.
2) Press Alt+F11 to open the MS Visual Basic editor.
3) Paste the entire putslidenos.txt file in the big window.
If the big window doesn't show up, right-click on VBAProject ..., and choose Insert->Module
4) Edit the constants (position, font, etc.) at the top as desired.
5) Close MS Visual Basic.
6) Save the .ppt.

7) Do whatever hiding etc. has to be done.
8) Select the first slide in the slide sorter (basically make sure nothing
on any slide is selected).
9) Choose Tools->Macro->Macros. Select PutSlideNos and click run. (Undo
still seems to work if the output wasn't nice.)
10) Save.

The first 6 steps are to be done only once. 7-10 is done after each edit (before the actual presentation).

Impt.: Note that with the default settings, the macro removes all textboxes of the form "number of number" before adding its own textboxes. If this might be a problem, change the settings as needed and/or save changed files into different files at step 10.



'
' Copyright 2007,2008 Abhijit P. Pai
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program. If not, see .
'
'User-settable constants

'~725 * ~540 seems to be the max x and y
'startx and starty are the starting x and y locations of the textbox
'showing the slide number
Const startx = 622#
Const starty = 495#
Const mywidth = 100#
Const myheight = 30#

Const myfontname = "Arial"
Const myfontsize = 10
Const starttext = "Slide "
Const midtext = " of "

'set this to True if you want to remove the old numbering before you add the new one, else False
Const RemoveBeforePutting = True

'End User-settable constants
'-------------------------------------------------------------

Sub PutSlideNos()

If RemoveBeforePutting = True Then Call RemoveSlideNos

'total number of slides
a = ActiveWindow.Presentation.Slides.Count

'total number of hidden slides
b = 0
For i = 1 To ActiveWindow.Presentation.Slides.Count
If ActivePresentation.Slides(i).SlideShowTransition.Hidden = -1 Then b = b + 1
Next i
nonhidden = a - b

j = 0
For i = 1 To ActiveWindow.Presentation.Slides.Count
ActiveWindow.Presentation.Slides(i).Select
j = j + 1

'-1 means true for this property
If ActivePresentation.Slides(i).SlideShowTransition.Hidden = -1 Then
j = j - 1
GoTo nexttry
End If

ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal,startx, starty, mywidth, myheight).Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1,Length:=0).Select
ActiveWindow.Selection.TextRange.Text = starttext + Trim(Str(j)) + midtext + Trim(Str(nonhidden))
With ActiveWindow.Selection.TextRange.Font
.Name = myfontname
.Size = myfontsize
End With
nexttry:
Next i

ActiveWindow.Presentation.Slides(1).Select
End Sub



Sub RemoveSlideNos()
For i = 1 To ActiveWindow.Presentation.Slides.Count
ActiveWindow.Presentation.Slides(i).Select
j = 1

While j
If ActiveWindow.Presentation.Slides(i).Shapes(j).TextFrame.HasText Then
t = ActiveWindow.Presentation.Slides(i).Shapes(j).TextFrame.TextRange.Characters.Text
If t Like starttext + "[0-9]*" + midtext + "[0-9]*" Then
ActiveWindow.Presentation.Slides.Item(i).Shapes.Item(j).Delete
End If
End If

j = j + 1
thecount = ActiveWindow.Presentation.Slides.Item(i).Shapes.Count
If j > thecount Then GoTo endwhile
Wend


endwhile:
Next i
ActiveWindow.Presentation.Slides(1).Select

End Sub