VBA golive countdown

ryanmcclung4071 · 2014-01-08T18:36:26.000Z

Greetings all.

Please see below code:

Option Explicit
'API Declarations
Declare Function SetTimer Lib "user32" _
                            (ByVal hwnd As Long, _
                             ByVal nIDEvent As Long, _
                             ByVal uElapse As Long, _
                             ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" _
                            (ByVal hwnd As Long, _
                             ByVal nIDEvent As Long) As Long
 
' Public Variables
Public TimerID As Long
Public bTimerState As Boolean
Public Const TargetDateTime As Date = "04/14/2014 08:00:00"

Sub TimerOnOff()
If bTimerState = False Then
    TimerID = SetTimer(0, 0, 1000, AddressOf TimerProc)
    If TimerID = 0 Then
        MsgBox "Unable to create the timer", vbCritical + vbOKOnly, "Error"
        Exit Sub
    End If
    bTimerState = True
Else
    TimerID = KillTimer(0, TimerID)
    If TimerID = 0 Then
        MsgBox "Unable to stop the timer", vbCritical + vbOKOnly, "Error"
    End If
    bTimerState = False
End If
End Sub
 
' The defined routine gets called every nnnn milliseconds.
Sub TimerProc(ByVal hwnd As Long, _
                    ByVal uMsg As Long, _
                    ByVal idEvent As Long, _
                    ByVal dwTime As Long)

Dim diff As Date
Dim out As String
Dim maxshapes As Integer
Dim i As Integer

diff = TargetDateTime - Now

out = ""
If CInt(diff) <> 0 Then
    out = out + CStr(CInt(diff))
    If CInt(diff) = 1 Then
        out = out + ":"
    Else
        out = out + ":"
    End If
End If

    out = out + CStr(Hour(diff))
    If Hour(diff) > 1 Then
        out = out + ":"
    Else
        out = out + ":"
    End If

    out = out + CStr(Minute(diff))
    If Minute(diff) > 1 Then
        out = out + ":"
    Else
        out = out + ":"
    End If
    
    out = out + CStr(Second(diff))
    If Second(diff) < 10 Then
        If Second(diff) > 1 Then
            Second(diff) = "0" + Second(diff)
        Else
            Second(diff) = "0" + Second(diff)
        End If
    End If
    
        
    
    
    

On Error GoTo err:
For i = 1 To ActivePresentation.Slides.Count
    maxshapes = ActivePresentation.Slides(i).Shapes.Count
    
    ActivePresentation.Slides(i).Shapes(maxshapes).TextFrame.TextRange.Text = out
Next i

err:

End Sub

Now, yes I know, the script would fail. That’s what I’ve been struggling with

Here is my question:

I am making a count down timer in VBA to show in a powerpoint script. It was working beautifully! … then the client wanted the seconds to be double digits when it is less than 10 seconds. Hence the broken bit at the second mark. Any ideas?

martin9700 · 2014-01-08T18:45:30.000Z

Instead of posting the entire script, how about just posting the relevant portion and showing any errors you’re getting? It’s tough for someone to wrap their head around the entire thing like this.

ryanmcclung4071 · 2014-01-08T18:48:35.000Z

Dim diff As Date
Dim out As String
Dim maxshapes As Integer
Dim i As Integer

diff = TargetDateTime - Now

out = ""
If CInt(diff) <> 0 Then
    out = out + CStr(CInt(diff))
    If CInt(diff) = 1 Then
        out = out + ":"
    Else
        out = out + ":"
    End If
End If

    out = out + CStr(Hour(diff))
    If Hour(diff) > 1 Then
        out = out + ":"
    Else
        out = out + ":"
    End If

    out = out + CStr(Minute(diff))
    If Minute(diff) > 1 Then
        out = out + ":"
    Else
        out = out + ":"
    End If
    
    out = out + CStr(Second(diff))
    If Second(diff) < 10 Then
        If Second(diff) > 1 Then
            Second(diff) = "0" + Second(diff)
        Else
            Second(diff) = "0" + Second(diff)
        End If
    End If


Sorry Martin and SW community.

martin9700 · 2014-01-08T18:56:33.000Z

So where is it going wrong for you, and what’s the error you’re seeing?

ryanmcclung4071 · 2014-01-08T19:02:58.000Z

I just figured it out myself Thanks anyway Martin.

Gonna mark you as best answer anyway. Thanks again!

martin9700 · 2014-01-08T19:05:07.000Z

rmcclung:

I just figured it out myself Thanks anyway Martin.

Gonna mark you as best answer anyway. Thanks again!

Sometimes just asking the question is enough to figure the problem out! Congrats!

ryanmcclung4071 · 2014-01-08T19:35:48.000Z

For those who may need the answer in the future.

Dim diff As Date
Dim out As String
Dim maxshapes As Integer
Dim i As Integer

diff = TargetDateTime - Now

out = ""
If CInt(diff) <> 0 Then
    out = out + CStr(CInt(diff))
    If CInt(diff) = 1 Then
        out = out + ":"
    Else
        out = out + ":"
    End If
End If
  
    If CStr(Hour(diff)) < 10 Then
        out = out + "0" + CStr(Hour(diff))
    Else
        out = out + CStr(Hour(diff))
    End If
    
    If CStr(Minute(diff)) < 10 Then
        out = out + ":0" + CStr(Minute(diff))
    Else
        out = out + ":" + CStr(Minute(diff))
    End If
    
    
    If CStr(Second(diff)) < 10 Then
        out = out + ":0" + CStr(Second(diff))
    Else
        out = out + ":" + CStr(Second(diff))
    End If

Enjoy!