This code will help you to add a progress bar to your power point.
This can be useful for:
- Controlling your presentation time.
- Keeping the attention of your audience.
VBA Code:
Sub AddProgressBar()
On Error Resume Next
Dim slide As slide
Dim X As Integer, Y As Integer, Z As Integer
X = 0 'total unhidden slides
Y = 0 'Unhidden so far
Z = 0 'Total
' Loop through all slides in the presentation to count slides and delete previous bars
For Each slide In ActivePresentation.Slides
ActivePresentation.Slides(X + 1).Shapes("HMB").Delete
If slide.SlideShowTransition.Hidden = False Then
X = X + 1
End If
Next slide
' Loop through all slides in the presentation to add the bars based on required width
For Each slide In ActivePresentation.Slides
Z = Z + 1
ActivePresentation.Slides(Z).Shapes("HMB").Delete
If slide.SlideShowTransition.Hidden = False Then
' Increment the counter if the slide is not hidden
Y = Y + 1
Set HMBs = ActivePresentation.Slides(Z).Shapes.AddShape(msoShapeRectangle, 0, ActivePresentation.PageSetup.SlideHeight - 32, ActivePresentation.PageSetup.SlideWidth * Y / X, 15)
'HMBs.Fill.ForeColor.RGB = RGB(255, 255, 255) 'white bar
'HMBs.Fill.ForeColor.RGB = RGB(255, 0, 0) 'red bar
HMBs.Fill.ForeColor.RGB = RGB(0, 255, 0) 'red bar
HMBs.Name = "HMB"
End If
Next slide
End Sub
Thank you!
