klok die automatisch start en stopt bij resp. openen of sluiten

Status
Niet open voor verdere reacties.
E

ExcelExcellence

Gebruiker
Lid geworden
3 sep 2020
Berichten
22
Hello Forumfolks,

Heb in een xlsm bestand een klok lopen (ververst iedere 20 sec.) in cell H2 met onderstaande code die ik van het net geplukt heb.
De klok bedien ik met 2 knoppen die de klok starten via 'recalc' danwel stoppen met 'disable' macro.
Werkt prima maar had graag dat de klok ook automatisch start als ik het bestand open en stopt als ik het bestand sluit. (dus zonder de knoppen te gebruiken).
***lige is namelijk dat als je de klok vergeet te stoppen het bestand opnieuw opent als je'm sluit... en soms werken 'dingen' niet en dan kom je er na een poosje pas achter dat de klok niet loopt. :p

Heb gezocht op het web maar heb helaas tot nu toe niks 'werkends' gevonden.
Kan iemand onderstaande code aanpassen of me voorzien van totaal andere/betere code die aan 'mijn wensen' voldoet?


Much obliged, :eek:)



Code: 
Dim SchedRecalc As Date

Sub Recalc()
    With Sheet1.Range("H2")
    .Value = Format(Time, "hh:mm:ss AM/PM")
End With
    Call SetTime
End Sub

Sub SetTime()
    SchedRecalc = Now + TimeValue("00:00:20")
    Application.OnTime SchedRecalc, "Recalc"
End Sub

Sub Disable()
    On Error Resume Next
    Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Recalc", Schedule:=False
End Sub
 
achter het werkblad hangen met actie before close event?
en bij openen van het bestand.
 
Laatst bewerkt:
Er vanuit gaande dat je bestaande code in een Module zit, dit in de ThisWorkbook sectie:
Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Disable
End Sub

Private Sub Workbook_Open()
    SetTime
End Sub
 
Laatst bewerkt:
werkt niet :(

Edmoor,

Mijn code zit idd in een module en ik heb jou code in het werkblad geplaatst.... helaas werkt het niet.
De klok stopt niet bij sluiten alswel start niet bij openen.

Zou het bestand willen toevoegen maar heb al meerder keren geprobeerd het te uploaden maar hij wil niet... :confused:

grts,


code in Sheet1:

Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Disable
End Sub

Private Sub Workbook_Open()
    SetTime
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A5:A4000")) Is Nothing And Target.Count = 1 Then
    With Target
      .Offset(, 24) = IIf(Target.Value = "", "", .Offset(, 22).Value)
      .Offset(, 25) = IIf(Target.Value = "", "", Now)
    End With
  End If
End Sub
 
Plaats je bestand (voorbeeld zonder privacy-gevoelige info) eens.
 
Wat ik zei moet ook niet in Sheet1 maar, zoals ik erbij schreef, in de ThisWorkbook sectie.
 
Ahum.... :eek:

Ja goed lezen is ook een kunst!
Code geplaatst in "ThisWorkbook" en het werkt als een speer!

Supertoll!

Thx Edmoor! :thumb:

en @SjonR ... ja ga nu proberen uit te zoeken waarom ik geen bestand kan uploaden.... want dat lukte dus niet.
Anywho.... problem solved!

Grts
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan