Insert a progress bar to Powerpoint presentation

Insert a progress bar to Powerpoint presentation .md

Intro

To view the progress of a Powerpoint presentation, a progress bar can be displayed at the bottom of the slide show.

How to proceed

Once the slideshow is complete, go to Tools > Macro > Visual Basic Editor.

In the new window, select Insert > Module and copy this text in the blank page:

Sub AddProgressBar()
    On Error Resume Next
        With ActivePresentation
              sHeight = .PageSetup.SlideHeight - 12
              n = 0
              j = 0
              For i = 1 To .Slides.Count
                If .Slides(i).SlideShowTransition.Hidden Then j = j + 1
              Next i:
              For i = 2 To .Slides.Count
                .Slides(i).Shapes("progressBar").Delete
                If .Slides(i).SlideShowTransition.Hidden = msoFalse Then
                  Set slider = .Slides(i).Shapes.AddShape(msoShapeRectangle, 0, sHeight, (i - n) * .PageSetup.SlideWidth / (.Slides.Count - j), 12)
                  With slider
                      .Fill.ForeColor.RGB = ActivePresentation.SlideMaster.ColorScheme.Colors(ppFill).RGB
                      .Name = "progressBar"
                  End With
                Else
                   n = n + 1
                End If
              Next i:
        End With
End Sub

Then go to File > Close > Return to Microsoft PowerPoint In the displayed page of Microsoft Powerpoint, go to: Tools > Macro > Macros, then select AddProcessBar and press Execute

How remove the progress bar?

To remove the progress bar make we can add the following function:

Sub RemoveProgressBar()
    On Error Resume Next
        With ActivePresentation
              For i = 1 To .Slides.Count
              .Slides(i).Shapes("progressBar").Delete
              Next i:
        End With
End Sub

PPT-Progress-Bar-with-Page-Numbers.vbs

'' Add progress bar and page numbers to all non-hidden pages
Sub AddProgressBar()
    On Error Resume Next
        With ActivePresentation
              sHeight = .PageSetup.SlideHeight - 12
              n = 0
              j = 0
              For i = 1 To .Slides.Count
                If .Slides(i).SlideShowTransition.Hidden Then j = j + 1
              Next i:
              For i = 2 To .Slides.Count
                .Slides(i).Shapes("progressBar").Delete
                .Slides(i).Shapes("pageNumber").Delete
                If .Slides(i).SlideShowTransition.Hidden = msoFalse Then
                  Set slider = .Slides(i).Shapes.AddShape(msoShapeRectangle, 0, sHeight, (i - n) * .PageSetup.SlideWidth / (.Slides.Count - j), 12)
                  With slider
                      .Fill.ForeColor.RGB = ActivePresentation.SlideMaster.ColorScheme.Colors(ppFill).RGB
                      .Name = "progressBar"
                  End With
                  Set pageNumber = .Slides(i).Shapes.AddTextbox(msoTextOrientationHorizontal, ((i - n) * .PageSetup.SlideWidth / (.Slides.Count - j)) - 40, .PageSetup.SlideHeight - 15, 100, 10)
                  With pageNumber
                      .TextFrame.TextRange.Text = Str(i - n) & "/" & Str(ActivePresentation.Slides.Count - j)
                       With .TextFrame.TextRange.Font
                           .Bold = msoFalse
                           .Size = 10
                       End With
                       .Name = "pageNumber"
                   End With
                  Else
                    n = n + 1
                  End If
              Next i:
        End With
End Sub

'' Macro to remove the progress bar from all the slides
Sub RemoveProgressBar()
    On Error Resume Next
        With ActivePresentation
              For i = 1 To .Slides.Count
              .Slides(i).Shapes("progressBar").Delete
              .Slides(i).Shapes("pageNumber").Delete
              Next i:
        End With
End Sub

PPT-Progress-Bar.vbs

'' Add progress bar only to all non-hidden pages
Sub AddProgressBar()
    On Error Resume Next
        With ActivePresentation
              sHeight = .PageSetup.SlideHeight - 12
              n = 0
              j = 0
              For i = 1 To .Slides.Count
                If .Slides(i).SlideShowTransition.Hidden Then j = j + 1
              Next i:
              For i = 2 To .Slides.Count
                .Slides(i).Shapes("progressBar").Delete
                If .Slides(i).SlideShowTransition.Hidden = msoFalse Then
                   Set slider = .Slides(i).Shapes.AddShape(msoShapeRectangle, 0, sHeight, (i - n) * .PageSetup.SlideWidth / (.Slides.Count - j), 12)
                   With slider
                       .Fill.ForeColor.RGB = ActivePresentation.SlideMaster.ColorScheme.Colors(ppFill).RGB
                       .Name = "progressBar"
                   End With
                Else
                   n = n + 1
                End If
              Next i:
        End With
End Sub

'' Macro to remove the progress bar from all the slides
Sub RemoveProgressBar()
    On Error Resume Next
        With ActivePresentation
              For i = 1 To .Slides.Count
              .Slides(i).Shapes("progressBar").Delete
              Next i:
        End With
End Sub

@PiiXiieeS How can the progress bar be moved from the bottom to the top of the slides?

If you check the reference here: https://msdn.microsoft.com/en-us/library/office/ff744336.aspx and notice https://gist.github.com/PiiXiieeS/7181980#file-ppt-progress-bar-with-page-numbers-vbs-L15 or https://gist.github.com/PiiXiieeS/7181980#file-ppt-progress-bar-vbs-L14 it looks liek you would probably use some small number (0 or so) instead of sHeight

Great solution, thanks! Do you know a way to have section names listed along the progress bar? Something like this Beamer example: http://i.stack.imgur.com/eRU12.png

Hi, this bar is great! I'm completely new to VBA, but it would be great if the bar could go all the way across the bottom of the page, and the progress was marked by part of the bar being one color, and the remaining part of the bar being another color (for example, the same color but a lighter shade). Would someone be able to point me in the direction of how to figure this out? Many thanks for sharing and for your advice.

Fantastic and THANK YOU to the programmer.
Is there a way for the bar to start as all the way across and decrease in length towards the right as the slides progress - sort of like a fuse burning down?
Thanks,
Garry34

Hi, just for everyone interested, you may take a look at the version I have on my website (here on github only an old version):
https://datenbank-projekt.de/index.php/beispiele/progress-indicator-powerpoint-2010-2013-2016-32-and-64-bit-windows-and-mac-os

Looks like this

(if the image is missing, just come visit the page and download)
It's free, includes source code and works on Win and MAC

Olaf

Haha if only I saw your comment sooner, seems to be able to generate what I wanted!
I created this one by forking this:

To be found here:
https://gist.github.com/OkkeHendriks/c8d8a5fe71201cc59cbf190e4b8e4f78#file-ppt-progress-bar-circles-vbs