개인 공간

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