How do I make a VBA count down timer for powerpoint (single slide no animation)?

I want to make a timer to countdown from a set time (or number) to zero.  I want to have something on the screen during slide show mode where I hit an active x button or advance to the next slide to run a macro to start a countdown timer on screen.  I don;t want to create 20 additional slides that are animated together.  I just wanted to do it with VBA code.  Can it be done?

 

I tried this code, but it seems to work when I step through it in edit mode, but it just crashes in slide show mode.  Any suggestions?

 

thanks,

Tim

 

Option Explicit
 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Private Sub CommandButton1_Click()
  
    Dim Pre             As Presentation
    Dim Sld             As Slide
    Dim Shp            As Shape
    Dim i                 As Integer
       
    Set Pre = ActivePresentation
    i = 10
   
   ' this was supposed to be error trapping, but I think it only works in edit mode
'   With ActiveWindow
'     If .View.Type = ppViewNotesPage Then
'         .ViewType = ppViewSlide
'     End If
' End With
 
  'PowerPoint.Slide activeSlide = Application.ActiveWindow.View.Slide -failed
 Set Sld = Application.ActiveWindow.View.Slide
  'Set Sld = ActivePresentation.SlideShowWindow.View.CurrentShowPosition - failed
  

'supposedly will return the value of the slide that is displayed

'Set Sld = ActivePresentation.SlideShowWindow.View.Slide.SlideIndex  '(hangs up in slide mode with tyoe mismatch error)

'makes rectangular text box

Set Shp = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
     Left:=50, Top:=50, Width:=500, Height:=200)
 Shp.Fill.ForeColor.RGB = vbBlue
 Shp.Fill.BackColor.RGB = vbBlack
 Shp.TextEffect.FontName = "DS-Digital"
 Shp.TextEffect.FontSize = 244
'need to add formatting command for minutes and seconds 


 'updates the value in the text box
 Shp.TextFrame.TextRange = i

'supposed to loop through the values, going from i, down to 0   
While i > 0
i = i - 1

 

' to make the macro "sleep" for 1000 milliseconds

Sleep 1000 

 

'an attempt to force the textbox value to refresh

Shp.Select
Shp.Delete

Set Shp = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
     Left:=50, Top:=50, Width:=500, Height:=200)
 Shp.Fill.ForeColor.RGB = vbBlue
 Shp.Fill.BackColor.RGB = vbBlack
 Shp.TextEffect.FontName = "DS-Digital"
 Shp.TextEffect.FontSize = 244

 

'updates the value of text box

Shp.TextFrame.TextRange = i

Wend

 

Question Info


Last updated January 30, 2020 Views 23,293 Applies to:
Answer
Answer
If you need to use vba in the presentation than Shyam's method is good (of course)

You do not need to have 20 slides to make an animated timer though.

See here for code which makes the required animated shapes and then can be deleted as it is no longer needed..
www.pptalchemy.co.uk

Did this solve your problem?

Sorry this didn't help.

Great! Thanks for marking this as the answer.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this response?

Thanks for your feedback.

Answer
Answer

Hi,

Look at the couple of examples on this page - http://skp.mvps.org/ppt00021.htm, especially the one using SetTimer/KillTimer API

 

Don't mix the two modes. Slide Show mode is distinct from the design mode. In design mode you can perform selection, in slideshow you cannot.

 

'Run this code in slide show mode only. Don't quit the slide show till the countdown is done.

 

 Dim sld As Slide
 
 Set sld = SlideShowWindows(1).View.Slide
 Set Shp = sld.Shapes.AddShape(Type:=msoShapeRectangle, _
      Left:=50, Top:=50, Width:=500, Height:=200)
 
 Shp.Fill.ForeColor.RGB = vbBlue
 Shp.Fill.BackColor.RGB = vbBlack
 Shp.TextEffect.FontName = "DS-Digital"
 Shp.TextEffect.FontSize = 244
 Dim i As Integer
 
 For i = 10 To 0 Step -1
    Shp.TextFrame.TextRange = i
   
    'refresh the slide
    With SlideShowWindows(1).View
       .GotoSlide (.CurrentShowPosition)
    End With
    'sleep for 1 sec
    Sleep (1000)
    'let powerpoint do what it needs to do
    DoEvents
 Next

Regards
Shyam Pillai

http://skphub.com

Did this solve your problem?

Sorry this didn't help.

Great! Thanks for marking this as the answer.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this response?

Thanks for your feedback.