Powerpoint : Display slide progress percentage

[exl]

Is there a way to display the slide progress percentage on each slide, along the slide number.


In my current power-point template I have the following data to display slide progress in a text box


SlideNumber of TotalNumberofSlides


The TotalNumberofSlides is manually entered in the Slide Master, as I have many slides in backup which are kept after the 'Thank You' slide. What I require is a percentage which will be basically SlideNumber / TotalNumberofSlides %


So, it will look something like this:


15 of 100 (15%)

[John Wilson]

Sub addpercent()
Dim osld As Slide
Dim shpSN As Shape
Dim strPercent As String
For Each osld In ActivePresentation.Slides
strPercent = " (" & CStr(Round((osld.SlideIndex / ActivePresentation.Slides.Count) * 100, 1)) & "%)"
osld.HeadersFooters.SlideNumber.Visible = True
Set shpSN = getSN(osld)
If Not shpSN Is Nothing Then
'if you have manually added of xx
shpSN.TextFrame.TextRange.InsertAfter strPercent
'OR if not
'shpSN.TextFrame.TextRange.InsertAfter " of " & ActivePresentation.Slides.Count & strPercent
End If
Next osld
End Sub

Function getSN(osld As Slide) As Shape
For Each getSN In osld.Shapes
If getSN.Type = msoPlaceholder Then
If getSN.PlaceholderFormat.Type = ppPlaceholderSlideNumber Then
Exit Function
End If
End If
Next getSN
End Function

[exl]

Dear John,

Thanks for your help. I am a newbie when it comes to PPT Macro. Could you just guide me a little bit more as to what more I need to do, here are the steps I have taken in my existing presentation:

1. I have copied the code and pasted in VBAProject(FileName) > Insert Module

2. I have saved the file as .pptm (macro enabled)

3. After saving and re-opening the presentation and enabling macro, I don't see any change either in the Normal Mode or in the slideshow mode

4. I even tried to RUN the macro from Ribbon > View > Macro

5. I have two shapes in the slide master for for Slide Number like this <##> of 121

[exl]

Dear John,

Am uploading my presentation so that you can have a better look at it. Have to mask the URL since as a new user on this site I cannot post hyperlinks, please remove the dollar ($) signs

Here is it : $h$ttp$://www1$.$datafilehost.com/d/984550ea

[John Wilson]

You have removed the slide number placeholders!! Obviously the code will not find them

Try this (http://www.pptalchemy.co.uk/Downloads/AddPercentageSlides.ppt)

[exl]

You have removed the slide number placeholders!! Obviously the code will not find them



Dear John, Thanks for the help. Its looks just the way I visualized it to be. Could you let me know how to replicate the same when I add more slides to it, because in this file, it is not automatically taking the page number. Also if I re-run the code after adding the slides, it is looking like this:


5 of 4 (100%) of 5 (100%)

[John Wilson]

I should have thought of that! You need to delete the old value each time:


Sub addpercent()
Dim osld As Slide
Dim shpSN As Shape
Dim strPercent As String
For Each osld In ActivePresentation.Slides
strPercent = " (" & CStr(Round((osld.SlideIndex / ActivePresentation.Slides.Count) * 100, 1)) & "%)"
osld.HeadersFooters.SlideNumber.Visible = True
Set shpSN = getSN(osld)
If Not shpSN Is Nothing Then
With shpSN.TextFrame.TextRange
.Text = ""
.InsertSlideNumber
.InsertAfter " of " & ActivePresentation.Slides.Count & strPercent
End With
End If
Next osld
End Sub

Function getSN(osld As Slide) As Shape
For Each getSN In osld.Shapes
If getSN.Type = msoPlaceholder Then
If getSN.PlaceholderFormat.Type = ppPlaceholderSlideNumber Then
Exit Function
End If
End If
Next getSN
End Function

[exl]

I should have thought of that! You need to delete the old value each time:


Sub addpercent()
Dim osld As Slide
Dim shpSN As Shape
Dim strPercent As String
For Each osld In ActivePresentation.Slides
strPercent = " (" & CStr(Round((osld.SlideIndex / ActivePresentation.Slides.Count) * 100, 1)) & "%)"
osld.HeadersFooters.SlideNumber.Visible = True
Set shpSN = getSN(osld)
If Not shpSN Is Nothing Then
With shpSN.TextFrame.TextRange
.Text = ""
.InsertSlideNumber
.InsertAfter " of " & ActivePresentation.Slides.Count & strPercent
End With
End If
Next osld
End Sub

Function getSN(osld As Slide) As Shape
For Each getSN In osld.Shapes
If getSN.Type = msoPlaceholder Then
If getSN.PlaceholderFormat.Type = ppPlaceholderSlideNumber Then
Exit Function
End If
End If
Next getSN
End Function

WOW John, that works like a dream. Thank you so much for your patience and support. I believe this is something which many people will be looking out there, it should be made sticky in this section.

You Rock man!