A Timer for a PowerPoint Slide

You may already know how to create a timer, maybe for a break timer that counts up or down.

You can do this by using a large number of duplicate shapes each with different text, aligning them all to overlay each other and then create timed animations to add or remove shapes.

There's an example by Andrew May here. This can look great but it can take an age to create all the shapes and animate them all with delays. If you don't want to use vba in the presentation though it's a good answer.

vba to the rescue then (not included in the final presentation though!)

Simply create ONE shape or textbox with text in the style you need (Any text will do but make it as long as the longest possible time), select it and run the macro below.

Alchemy! A two minute counter ready animated.

You can change the code to have any duration and have it count down or up.

The Code (This is a new version that allows transparent backgrounds and even semi transparent text)

Sub Time_Me()
Dim oshp As Shape
Dim oshpRng As ShapeRange
Dim osld As Slide
Dim oeff As Effect
Dim i As Integer
Dim Iduration As Integer
Dim Istep As Integer
Dim dText As Date
Dim texttoshow As String
On Error GoTo errhandler
If ActiveWindow.Selection.ShapeRange.Count > 1 Then
MsgBox "Please just select ONE shape!"
Exit Sub
End If
Set osld = ActiveWindow.Selection.SlideRange(1)
Set oshp = ActiveWindow.Selection.ShapeRange(1)
oshp.Copy

'change to suit
Istep = 1
Iduration = 120 'in seconds

For i= 0 to iDuration Step Istep

' to count DOWN use

'For i = Iduration To 0 Step -Istep
Set oshpRng = osld.Shapes.Paste
With oshpRng
.Left = oshp.Left
.Top = oshp.Top
End With
dText = CDate(i \ 3600 & ":" & ((i Mod 3600) \ 60) & ":" & (i Mod 60))
If Iduration < 3600 Then
texttoshow = Format(dText, "Nn:Ss")
Else
texttoshow = Format(dText, "Hh:Nn:Ss")
End If
oshpRng(1).TextFrame.TextRange = texttoshow
Set oeff = osld.TimeLine.MainSequence _
.AddEffect(oshpRng(1), msoAnimEffectFlashOnce, , msoAnimTriggerAfterPrevious)
oeff.Timing.Duration = Istep
Next i
oshp.Delete
Exit Sub
errhandler:
MsgBox "**ERROR** - Maybe nothing is selected?"
End Sub

Adapting the Code

As it stands the code produces a 120 second timer in 5 second intervals

To change the duration of the timer simply change the value of Iduration
To change the interval change the value of Istep
NOTE Iduration should be an exact multiple of Istep!
To make the code countdown instead of up reverse the loop and make Istep > -Istep

eg

For i=0 to Iduration Step Istep

Even Simpler Version!

This version jusi counts down NUMBERS, As above you can easily modify it to count UP by changing the line:

For i = Iduration To 0 Step -Istep

To:

For i=0 to Iduration Step Istep

Sub Time_Me2()
Dim oshp As Shape
Dim oshpRng As ShapeRange
Dim osld As Slide
Dim oeff As Effect
Dim i As Integer
Dim Iduration As Integer
Dim Istep As Integer
Dim texttoshow As String
On Error GoTo errhandler
If ActiveWindow.Selection.ShapeRange.Count > 1 Then
MsgBox "Please just select ONE shape!"
Exit Sub
End If
Set osld = ActiveWindow.Selection.SlideRange(1)
Set oshp = ActiveWindow.Selection.ShapeRange(1)
oshp.Copy

'change to suit
Istep = 1
Iduration = 60 'in seconds

For i = Iduration To 0 Step -Istep
Set oshpRng = osld.Shapes.Paste
With oshpRng
.Left = oshp.Left
.Top = oshp.Top
End With
texttoshow = CStr(i)
oshpRng(1).TextFrame.TextRange = texttoshow
Set oeff = osld.TimeLine.MainSequence _
.AddEffect(oshpRng(1), msoAnimEffectFlashOnce, , msoAnimTriggerAfterPrevious)
oeff.Timing.Duration = Istep
Next i
oshp.Delete
Exit Sub
errhandler:
MsgBox "**ERROR** - Maybe nothing is selected?"
End Sub

The code is NOT required to make the timer run. Once you have made the timer the code module can either be deleted or all the shapes copied and pasted to a new presentation

Other Animations

If you have further on click anmations on the slide then any click will STOP the timer sequence - not what you want probably!

Solve this by adding a full slide size rectangle set to 100% transparent and use this as a trigger for any further animations.

More on triggers here

Sample Presentation Made with this macro

How to use vba code in PowerPoint

Free Animated gif timers

How to make the video play throughout the PowerPoint show.

If you like this we can create a custom video of any time or design at a very reasonable price. Read more

Email for a quote