MS Excel

Téma: Timer (časovač) úprava kódu

Zaslal/a veny 23.4.2021 11:26

Zdravím
Chtěl bych požádat o radu.
Rád bych použil tento kód tak, abych mohl editovat ostatní buňky a odpočet v B2 stále běžel.
Public StopIt As Boolean
Public ResetIt As Boolean
Public LastTime
----------------------
Private Sub CommandButton1_Click()
Dim StartTime, FinishTime, TotalTime, PauseTime
StopIt = False
ResetIt = False
If Range("B1") = 0 Then
StartTime = Timer
PauseTime = 0
LastTime = 0
Else
StartTime = 0
PauseTime = Timer
End If
StartIt:
DoEvents
If StopIt = True Then
LastTime = TotalTime
Exit Sub
Else
FinishTime = Timer
TotalTime = FinishTime - StartTime + LastTime - PauseTime
TTime = TotalTime * 100
HM = TTime Mod 100
TTime = TTime \ 100
hh = TTime \ 3600
TTime = TTime Mod 3600
MM = TTime \ 60
SS = TTime Mod 60
Range("B1").Value = Format(hh, "00") & ":" & Format(MM, "00") & ":" & Format(SS, "00") & "." & Format(HM, "00")
If ResetIt = True Then
Range("B1") = Format(0, "00") & ":" & Format(0, "00") & ":" & Format(0, "00") & "." & Format(0, "00")
LastTime = 0
PauseTime = 0
End
End If
GoTo StartIt
End If
End Sub
-------------------
Private Sub CommandButton2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
StopIt = True
End Sub
------------------
Private Sub CommandButton3_Click()
Range("B1").Value = Format(0, "00") & ":" & Format(0, "00") & ":" & Format(0, "00") & "." & Format(0, "00")
LastTime = 0
ResetIt = True
End Sub

Našel jsem zde na Foru i kód od elninoslov který načítá vteřiny z D1 a byl taky přijatelný, jen bych potřeboval aby se na nule zastavil.
Public OldTime As Date
Public Citac As Long

Sub Timer2()
With Worksheets("List1")
Citac = Citac + 1
.Buttons("btnStartStop").Caption = "Stop Timer (" & TimeSerial(0, 0, .Cells(1, 4) - Citac + 1) & ")"
OldTime = Now + TimeSerial(0, 0, 1)
If Citac > .Cells(1, 4) Then
Citac = 0
End If
Application.OnTime OldTime, "Timer"
End With
End Sub

Sub StartStop()
With Worksheets("List1")
If Left(.Buttons("btnStartStop").Caption, 5) = "Start" Then
Call Timer
Else
.Buttons("btnStartStop").Caption = "Start Timer"
Application.OnTime OldTime, "Timer", Schedule:=False
Citac = 0
End If
End With
End Sub

Edit:Přikládám soubor kde jsou obě možnosti, nějak jsem na něj zapomněl

Díky V.