Add a "thermometer" progress bar to each slide
You'd like to have some on-slide indication of how far along in a presentation you are so you can better judge how to use the time remaining for your talk.
If you're not the Do It Yourself type, Geetesh Bajaj has already created a nice Thermometer for PowerPoint for you, ready to load and run. It's based on the code you see below but has several nice additions.
The following AddProgressBars macro will add a thin rectangle to the bottom of each slide. The width of the rectangle will be proportional to how far along the slide is in the presentation. In other words, on the 10th slide of a 20-slide presentation, the rectangle will be half the width of the slide. On the 20th slide, it'll be the full width of the slide.
The RemoveProgressBars macro will remove the rectangles that AddProgressBars adds.
Sub AddProgressBars() Dim X As Long Dim dblLeft As Double Dim dblTop As Double Dim dblheight As Double Dim oSh As Shape ' This determines how far in from left the progress bar will start: dblLeft = 0 ' This determines how high (in points) the progress bar will be: dblheight = 12 ' This puts the progress bar right against the bottom of the slide, no matter what its height dblTop = ActivePresentation.PageSetup.Slideheight - dblheight For X = 1 To ActivePresentation.Slides.Count ' Add a rectangle - it'll be formatted however you have your default object formatting set Set oSh = ActivePresentation.Slides(X).Shapes.AddShape(msoShapeRectangle, _ dblLeft, _ dblTop, _ (X * ActivePresentation.PageSetup.Slidewidth) / ActivePresentation.Slides.Count, _ dblheight) With oSh ' Change this to any color you like, if you like .Fill.ForeColor.RGB = RGB(127, 0, 0) ' Don't change this: .Name = "ThermometerBar" End With Next X End Sub Sub RemoveProgressBars() Dim X As Long On Error Resume Next For X = 1 To ActivePresentation.Slides.Count ActivePresentation.Slides(X).Shapes("ThermometerBar").Delete Next X End Sub
See How do I use VBA code in PowerPoint? to learn how to use this example code.