[Συναρτήσεις] Χρονόμετρο στην Excel

[Tasos]

Τζίμη έτσι,

Option Explicit

Dim ScheduledTime As Date
Dim EndTime As Date
Const ScheduledJob As String = "UpdateScreen"

Sub StartTimer()
 ' Αν δεν έχει περαστεί τιμή στη μεταβλητή EndTime, (που σημαίνει ότι είναι η πρώτη 
'εκτέλεση του StartTimer() ), τότε θα δοθεί η τιμή Now + TimeSerial(0, 20, 0) 
   If EndTime = 0 Then EndTime = TimeSerial(0, 20, 0)
    ScheduledTime = Now + TimeSerial(0, 0, 1)
    Application.OnTime EarliestTime:=ScheduledTime, _
                       Procedure:=ScheduledJob
End Sub

Sub PauseTimer()
    On Error Resume Next
   'EndTime = 0 '??? Αν θέλεις μηδενίζεις το χρονικό όριο
    Application.OnTime EarliestTime:=ScheduledTime, _
                       Procedure:=ScheduledJob, Schedule:=False
End Sub

Sub ResetTimer()
    PauseTimer
    EndTime = 0
    Sheet1.Range("F1") = TimeSerial(0, 0, 0)
End Sub

Sub UpdateScreen()
    With Sheet1.Range("F1")
        .Value = .Value + TimeSerial(0, 0, 1)  ' Η τιμή του κελιού + 1 δευτερόλεπτο.
        If .Value < EndTime Then StartTimer
    End With
End Sub

Φιλικά

Τάσος