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 top of the slide show.

How to proceed

Once the slideshow is complete, go to View > Macro and create a new macro.

In the VBS editor copy this text in the blank page:

'' Add progress bar only to all non-hidden pages
Sub AddProgressBar()
	On Error Resume Next
		With ActivePresentation
			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("leftBar").Delete
				If .Slides(i).SlideShowTransition.Hidden = msoFalse Then
					'' Progressbar in red
					Set sliderPro = .Slides(i).Shapes.AddShape(msoShapeRectangle, 0, 0, (i - n) * .PageSetup.SlideWidth / (.Slides.Count - j), 6)
					With sliderPro
						.Fill.ForeColor.RGB = RGB(124, 0, 0)
						.Line.Visible = msoFalse
						.Name = "progressBar"
					End With
					'' Bar whats left (total) in light grey
					Set sliderLeft = .Slides(i).Shapes.AddShape(msoShapeRectangle, (i - n) * .PageSetup.SlideWidth / (.Slides.Count - j), 0, (.PageSetup.SlideWidth - ((i - n) * .PageSetup.SlideWidth / (.Slides.Count - j))), 6)
					With sliderLeft
						.Fill.ForeColor.RGB = RGB(236, 240, 241)
						.Line.Visible = msoFalse
						.Name = "leftBar"
					End With
				Else
				   n = n + 1
				End If
			Next i:
		End With
End Sub

Then go to File > Close > Return to Microsoft PowerPoint You can now select AddProcessBar and press Execute

How remove the progress bar?

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

'' 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("leftBar").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
			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("leftBar").Delete
				If .Slides(i).SlideShowTransition.Hidden = msoFalse Then
					'' Progressbar in red
					Set sliderPro = .Slides(i).Shapes.AddShape(msoShapeRectangle, 0, 0, (i - n) * .PageSetup.SlideWidth / (.Slides.Count - j), 6)
					With sliderPro
						.Fill.ForeColor.RGB = RGB(124, 0, 0)
						.Line.Visible = msoFalse
						.Name = "progressBar"
					End With
					'' Bar whats left (total) in light grey
					Set sliderLeft = .Slides(i).Shapes.AddShape(msoShapeRectangle, (i - n) * .PageSetup.SlideWidth / (.Slides.Count - j), 0, (.PageSetup.SlideWidth - ((i - n) * .PageSetup.SlideWidth / (.Slides.Count - j))), 6)
					With sliderLeft
						.Fill.ForeColor.RGB = RGB(236, 240, 241)
						.Line.Visible = msoFalse
						.Name = "leftBar"
					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("leftBar").Delete
			Next i:
		End With
End Sub