VBA Code for Countup Timer

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi all,

I was kindly helped out a few weeks ago when trying to create a countup
timer on a slide of a powerpoint presentation. I have taken code from a
website and attempted to adapt it to what I need, with no success. I am by
no means competent on VBA code, so this may look a little amateurish, but if
anyone can tell me where I am going wrong it would be much appreciated!

Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Tmr()
'TRUE = Running; FALSE = Idle
Static isRunning As Boolean
If isRunning = True Then
End
Else
isRunning = True
Dim TMinus As Integer
Dim xtime As Date
'On Slide 1, Shape 1 is the textbox
With ActivePresentation.Slides(1)
.Shapes(2).TextFrame.TextRange.Text = "Total No. of" & vbCrLf & _
"Sales"
With .Shapes(1)
'Countdown in seconds
TMinus = 105468

Do While (TMinus < 105618)
' Suspend program execution for 1 second (1000 milliseconds)
Sleep 1000
.TextFrame.TextRange.Text = "105468" + TMinus

TMinus = TMinus + 1
DoEvents
Loop
End With
SlideShowWindows(1).View.GotoSlide (2)
isRunning = False
.Shapes(2).TextFrame.TextRange.Text = "Click here to start count"
End


End With
End If
End Sub

Basically I am trying to have a counter which will start at 105,468 and and
increment by 1 every 24 seconds until it reaches 105,618. Any help would be
much appreciated!!

Regards,
TBD
 
You might want to try this:
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Tmr()
'TRUE = Running; FALSE = Idle
Static isRunning As Boolean
If isRunning = True Then
End
Else
isRunning = True

Dim TMinus As Long
Dim Sec24Counter As Integer

Dim xtime As Date
'On Slide 1, Shape 1 is the textbox
With ActivePresentation.Slides(1)
.Shapes(2).TextFrame.TextRange.Text = "Total No. of" & vbCrLf &
_
"Sales"
.Shapes(1).TextFrame.TextRange.Text = "105468"
With .Shapes(1)
'Countdown in seconds
Sec24Counter = 0
Do While (TMinus < 105618)
' Suspend program execution for 1 second (1000
milliseconds)
Sleep 1000
If Sec24Counter = 24 Then
.TextFrame.TextRange.Text =
CLng(.TextFrame.TextRange.Text) + 1
TMinus = CLng(.TextFrame.TextRange.Text)
Sec24Counter = 0
End If
Sec24Counter = Sec24Counter + 1
DoEvents
Loop
End With
SlideShowWindows(1).View.GotoSlide (2)
isRunning = False
.Shapes(2).TextFrame.TextRange.Text = "Click here to start
count"
End


End With
End If
End Sub
 
Hi Shyam,

Thank you so much for this, it works a treat!!

And thanks for letting me use your code, its much appreciated!

Regards,
TBD
 
Back
Top