zwei Stoppuhren parallel laufen lassen
17.12.2018 11:53:28
Anja
ich benötige für einen Wettkampf (Judo) zwei Stoppuhren. Die eine nimmt die Kampfzeit auf, die andere wird bei einer Wertung dazu geschaltet und hat eine Dauer von 10 oder 20 Sekunden. Danach sollen beide Stoppuhren gleichzeitig anhalten, bzw. mit einem Tonsignal den Kampf als beendet erklären. Soweit habe ich das auch fast schon hinbekommen, allerdings halten die beiden Stoppuhren nicht gleichzeitig an. (1 Sekunde hängt die 1. Stoppuhr nach)
Vielleicht hat jemand eine Idee, wie ich das hinbekommen könnte?
Hier der Code dazu:
(Tabellenblatt)
Option Explicit
Private Sub CommandButton1_Click()
Startschalter
End Sub
Private Sub CommandButton2_Click()
Stoppschalter
End Sub
Private Sub CommandButton3_Click()
Startschalter2
End Sub
Private Sub CommandButton4_Click()
Stoppschalter2
End Sub
Option Explicit
Dim i As Integer
Dim j As Integer
Dim Stopp As Integer
Sub Startschalter()
If i = 0 Then
i = 1
If Stopp = 1 Then
Stopp = 0
i = 0
Exit Sub
End If
Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
End If
End Sub
Sub nexttick()
If Stopp = 1 Then
i = 0
'Tabelle1.Range("B1").Value = Tabelle1.Range("B1").Value + TimeValue("00:00:01")
Exit Sub
End If
If Tabelle1.Range("B1") = 0 Then
i = 0
Exit Sub
End If
Tabelle1.Range("B1").Value = Tabelle1.Range("B1").Value - TimeValue("00:00:01")
If Tabelle1.Range("B1").Value > TimeValue("00:00:05") Then
Tabelle1.Shapes("TextBox 1").Fill.ForeColor.RGB = RGB(255, 255, 255)
Else
Tabelle1.Shapes("TextBox 1").Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
i = 0
Startschalter
End Sub
Sub Stoppschalter()
i = 0
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "nexttick", , False
End Sub
Sub Startschalter2()
If j = 0 Then
j = 1
Application.OnTime Now + TimeValue("00:00:01"), "nexttick2"
End If
End Sub
Sub nexttick2()
If Tabelle1.Range("J1").Value > TimeValue("00:00:19") Then
j = 0
Stopp = 1
Exit Sub
End If
Tabelle1.Range("J1").Value = Tabelle1.Range("J1").Value + TimeValue("00:00:01")
'Tabelle1.Range("J2").Value = Tabelle1.Shapes("TextBox 11").Value
j = 0
Startschalter2
End Sub
Sub Stoppschalter2()
Tabelle1.Range("J1") = 0
j = 0
i = 0
Stopp = 0
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "nexttick2", , False
End Sub
Ich hoffe es ist einigermaßen verständlich. Die Variable i und j sind dafür da, dass ich nicht mehrfach hintereinander den Startschalter drücken kann und somit die Sekunden schneller ablaufen würden. Die Variable Stopp ist dafür gedacht, beide Stoppuhren zu stoppen, wenn die 2. Stoppuhr 20 Sekunden gelaufen ist.
VG
Anja