|
-
Jul 31st, 2011, 08:15 AM
#1
Thread Starter
New Member
Clock to check activity
I am working in a office where I need to keep track of few things to count time. I can't go and stand there all the time. So, I need a program where I can keep track of different things. I have found some codes but I really don't know what & how to utilize it.
this run the clock with micro seconds:
======================================
Code:
Private TimerCell As Range
Private TimerEnabled As Boolean
Private TimerValue As Double
Sub SetTimerCell()
Set TimerCell = Worksheets("Sheet1").Range("M2")
TimerCell.NumberFormat = "@"
End Sub
Sub StartTimer()
If TimerEnabled Then Exit Sub
If TimerCell Is Nothing Then SetTimerCell
TimerEnabled = True
ShowTime
End Sub
Sub StopTimer()
TimerEnabled = False
End Sub
Sub ResetTimer()
TimerEnabled = False
If TimerCell Is Nothing Then SetTimerCell
TimerValue = 600
TimerCell = "10:00.0"
End Sub
Sub ShowTime()
Dim Delay As Single
Dim Mins As Integer
Dim Secs As Variant
Dim StartTime As Single
Delay = 0.1
StartTime = Timer
Do While TimerEnabled
While Timer < StartTime + Delay: Wend
TimerValue = TimerValue - 0.1
Mins = Int(TimerValue) \ 60
Secs = TimerValue - (Mins * 60)
TimerCell.Value = Format(Mins, "00") & ":" & Format(Secs, "00.0")
StartTime = Timer
DoEvents
Loop
End Sub
this clock will run in A1 with running time and in A2 is will show Date and time (running time) depends on cell format
Code:
Dim RunClk As Boolean
'-----------------------
Sub RunPauseClk()
RunClk = Not (RunClk)
Do While RunClk = True
DoEvents
Range("A1") = TimeValue(Now)
Range("A2") = Now()
Loop
End Sub
------------------------------------
macro for running realtime clock:
Code:
Dim SchedRecalc As Date
Sub Recalc()
Range("C4").Value = Format(Time, "hh:mm:ss AM/PM")
Call SetTime
End Sub
Sub SetTime()
SchedRecalc = Now + TimeValue("00:00:01")
Application.OnTime SchedRecalc, "Recalc"
End Sub
---------------------------------------------------------
To add date, just add:
Code:
Range("C3").Value = Format(Now, "dd-mmm-yy")
after sub Recalc() in above macro
=========================================================
disable the running realtime clock (stopping the clock):
Code:
Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Recalc", Schedule:=False
End Sub
I want to get the total active time and keep it permanent even sheet is open after weeks.
My requirements are as followed:
At 5:30pm I have entered some time values on A (4:15pm) and date on B (31-07-2011) then I need a clock to start ticking on E starting 00/00:00:00hrs (dd/hh:mm:ss) but it was already 01:15:00 hour delayed so clock should start with 01:15hrs saying that activity was already started 01:15hrs before and keep running the clock on E till I enter the finish time on C (08:15) and date (31-07-2011)on D then I should have total time of the activity automatically (00/02:45:00) on E
Many thanks,
-
Aug 1st, 2011, 06:22 AM
#2
Re: Clock to check activity
the first code runs all the time and will, i imagine, make excel unresponsive
the realtime clock code, should work, without problem, to display the time in a cell if that is what you want and can be abbreviated to a single procedure
vb Code:
Sub SetTime() Range("C4").Value = Format(Time, "hh:mm:ss AM/PM") SchedRecalc = Now + TimeValue("00:00:01") Application.OnTime SchedRecalc, "SetTime" End Sub
to start the clock going put an entry in the workbook open event to call settime, once called it will continue to run, if you do not need one second updates you could increase the delay in timevalue
all the above codes just display the values of the computer clock in different formats, with different update frequency
you could also put a clock on your desk to do the same thing
if you want to use the time for other purposes you can read the value of the cell containing the time
you could also have a cells containing start times (or finishing times), and calculate running time (or countdown remaining time), but i am not sure what you want to achieve
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|