Option Explicit
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 TimerID As Long
Public bTimerState As Boolean
Public Const TargetDateTime As Date = "01/10/2013 23:59:59"
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
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 + " day "
Else
out = out + " days "
End If
End If
out = out + CStr(Hour(diff))
If Hour(diff) > 1 Then
out = out + " hours "
Else
out = out + " hour "
End If
out = out + CStr(Minute(diff))
If Minute(diff) > 1 Then
out = out + " Min "
Else
out = out + " Min "
End If
out = out + CStr(Second(diff))
If Second(diff) > 1 Then
out = out + " Sec"
Else
out = out + " Sec"
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