Option Explicit
Dim ctrMEN As CommandBarControl
Private Sub Workbook_BeforeClose(Cancel As Boolean)
For Each ctrMEN In Application.CommandBars("Worksheet Menu Bar").Controls
If ctrMEN.Tag = "countdown" Then ctrMEN.Delete
Next
End Sub
Private Sub Workbook_Open()
For Each ctrMEN In Application.CommandBars("Worksheet Menu Bar").Controls
If ctrMEN.Tag = "countdown" Then Exit Sub
Next
Set ctrMEN = Application.CommandBars("Worksheet Menu Bar").Controls.Add(msoControlPopup, , , , True)
ctrMEN.Tag = "countdown"
CountDown ctrMEN
End Sub
Private Sub CountDown(ByRef ctrCOUNTD As CommandBarControl)
Dim datZIEL As Date
Dim strJETZT As String
Dim dblSTART As Double
Dim datJETZT As Double
Dim cDown As Double
Dim lngTAG As Long
Dim lngSTUNDE As Long
Dim lngMINUTE As Long
Dim dblINTERIM As Double
datZIEL = CDbl(DateValue("2011-03-24"))
Do
dblSTART = Timer
If dblSTART > 86339 Then dblSTART = 0
strJETZT = Format(Now, "yyyy-MM-dd hh:mm")
datJETZT = CDbl(CDate(strJETZT))
cDown = datZIEL - datJETZT
lngTAG = CLng(Left(CStr(cDown), InStr(1, CStr(cDown), ",", vbBinaryCompare) - 1))
dblINTERIM = cDown - lngTAG
dblINTERIM = dblINTERIM * 86400
lngSTUNDE = dblINTERIM \ 3600
dblINTERIM = dblINTERIM - lngSTUNDE * 3600
lngMINUTE = dblINTERIM \ 60
ctrCOUNTD.Caption = " Noch " & CStr(lngTAG) & " Tage " & CStr(lngSTUNDE) _
& " Stunden " & CStr(lngMINUTE) & " Minuten"
While Timer < dblSTART + 60
DoEvents
Wend
Loop
End Sub