VBA Code Automatische Timer

[Roy023]

Goedemorgen allen,

Helaas helpt Google mij niet verder op dit moment dus ik dacht probeer het hier eens;

Ik probeer in Excel een aflopende timer te creëren die begint op 20 seconden (veld opmaak tijdsnotatie 00:00:20),
en dan afloopt na het veranderen van de waarde in een specifieke cel.

Nu is dat tot dusver gelukt. Het lukt me alleen niet om de startwaarde weer terug te krijgen na de afloop op 0.

Ik wil graag dat deze weer wijzigt naar 20 seconden, en daarna pas weer afloopt als de bovengenoemde cel wéér van waarde verandert.

De huidige code is als volgt;

In het worksheet t.b.v. activeren macro;

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Target.Worksheet.Range("F4")) Is Nothing Then timer

End Sub

En in module 1 de 3 subs waarvan ik hoopte dat ze achtereenvolgens zouden activeren;

Sub timer()

interval = Now + TimeValue("00:00:01")

If Range("H4").Value = 0 Then Exit Sub

Range("H4") = Range("H4") - TimeValue("00:00:01")

Application.OnTime interval, "timer"

End Sub

Sub stop_timer()

TimerOn = False

End Sub

Sub reset_timer()

If TimerOn = False Then

Range("H4").Value = TimeValue("00:00:20")

End Sub


Hopelijk kunnen jullie mij verder helpen, alvast bedankt!

 

[Roy023]

Uiteindelijk zelf op kunnen lossen na een dag functies ontdekken, haha. Hiervoor nog nooit met Macro's/VBA gewerkt..

Voor de geïnteresseerden;

In het werkblad;

Private Sub Worksheet_Change(ByVal Target As Range)​

​

If Not Intersect(Target, Target.Worksheet.Range("F4")) Is Nothing Then RunAll​

​

End Sub

​

In de module;

Sub timer()

interval = Now + TimeValue("00:00:01")

If Range("H4").Value = 0 Then Exit Sub

Range("H4") = Range("H4") - TimeValue("00:00:01")

Application.OnTime interval, "timer"

End Sub


---------------------------------------------------------------------------------------------------------------------

Sub DelayMacro()

Application.OnTime Now + TimeValue("00:00:30"), "reset_timer"

End Sub


---------------------------------------------------------------------------------------------------------------------

Sub reset_timer()

If Range("H4").Value = TimeValue("00:00:00") Then Range("H4") = TimeValue("00:00:20")

End Sub


---------------------------------------------------------------------------------------------------------------------
Sub RunAll()

Call timer
Call DelayMacro
Call reset_timer

End Sub



​

Ik ga dit gebruiken in een Dungeons and Dragons sheet waarin je een hele battle kunt tracken; players en enemies toevoegen,
sorteren op initiative en beurten bijhouden (nu dus met werkende timer).

 

[alphamax]

Uit de oude doos.

Ik denk dat jouw bestand niet gaat werken.
Elke seconde wordt jouw invoer in de cellen onderbroken door de timer.