Hallo,
irgendwann bin ich von Countdown auf Timer gekommen, lag wohl daran dass das ganze auch laufen soll wenn zwischen drin Excel geschlossen wird.
Das geht nämlich nur wenn man dem Countdown quasi eine feste Endzeit mitgibt, und parallel dann halt die Zeit bis zum Ende ausgibt.
Wenn es aber ein Countdown sein soll, kommt nur eine modifizierte Version vom 1. Beispiel in Frage.
So nun noch mal der geänderte Code
Voraussetzung:
Es muss eine Checkbox (Name CheckBox1) auf dem 1. Blatt vorhanden sein.
In Zelle A4 trägt man den Startwert des Counters an (00:01:00)
In Zelle B4 steht dann die Endzeit.
In VBA unter "DieseArbeismappe" folgenden Code einfügen
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ZählerLäuft Then Application.OnTime letzteZeit, "Timer", , False
ZählerLäuft = False
End Sub
Private Sub Workbook_Open()
Init
If Sheets(1).CheckBox1.Value Then
ZählerLäuft = True
start Time + TimeSerial(0, 0, 1), "Timer"
End If
End Sub
Im Code-Fenster vom 1. Blatt dann diesen Code
Option Explicit
Private Sub CheckBox1_Click()
Init
If CheckBox1.Value = 0 Then
If ZählerLäuft Then Application.OnTime letzteZeit, "Timer", , False
ZählerLäuft = False
Zaehler.Interior.Pattern = xlNone
Else
ZählerLäuft = True
start Time + TimeSerial(0, 0, 1), "Timer"
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Init
If Not Intersect(Target, Zaehler) Is Nothing And Not Pause Then
Alarm = Time + Zaehler
Me.CheckBox1.Value = 1
End If
End Sub
Und in einem Modul dann
Option Explicit
Public WarnFarbe As Long
Public AlarmFarbe As Long
Public Alarm As Range
Public Zaehler As Range
Public letzteZeit As Date
Public Pause As Boolean
Public ZählerLäuft As Boolean
Public WarnZeit As Long ' in Sek
Public Sub Timer()
Pause = True
If Alarm >= Time Then Zaehler = Alarm - Time Else Zaehler = 0
Pause = False
If Sheets(1).CheckBox1.Value Then
If DateDiff("s", Time, Alarm) <= WarnZeit And DateDiff("s", Time, Alarm) > 0 Then
Zaehler.Interior.Color = WarnFarbe
ElseIf DateDiff("s", Time, Alarm) <= 0 Then
If Zaehler.Interior.Color = AlarmFarbe Then
Zaehler.Interior.Pattern = xlNone
Else
Zaehler.Interior.Color = AlarmFarbe
End If
Else
Zaehler.Interior.Pattern = xlNone
End If
start Time + TimeSerial(0, 0, 1), "Timer"
Else
ZählerLäuft = False
End If
End Sub
Public Sub Init()
WarnFarbe = RGB(256, 256, 0)
AlarmFarbe = RGB(0, 256, 0)
WarnZeit = 60 * 60
Set Zaehler = Sheets(1).Range("A4")
Set Alarm = Sheets(1).Range("B4")
End Sub
Public Sub start(Zeit As Date, Prozedur As String)
letzteZeit = Zeit
Application.OnTime Zeit, Prozedur
End Sub
|