Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Save xshapira/3238f416c59fd82401b87da5fafce828 to your computer and use it in GitHub Desktop.
Save xshapira/3238f416c59fd82401b87da5fafce828 to your computer and use it in GitHub Desktop.
Insert a progress bar to Powerpoint presentation

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
'' 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
'' 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment