Home |
Search |
Today's Posts |
#1
|
|||
|
|||
clock
Does anyone has a way to put a clock in a cell
that runs while the spreadsheets open? is that possible? (I've seen the awesome clock on Pearson's wonderful sight but I just need a digital clock in one cell to calculate formulas in other cells) Thanks in advance Wildman |
#2
|
|||
|
|||
Something like:
Sub RunClock() Application.OnTime Now + TimeValue("00:00:01"), _ "UpdateClock" End Sub Sub UpdateClock() Range("A1") = Time RunClock End Sub I would recommend looking fo ranother approach, though, because this involves a macro that runs every second and may interfere with other things that you are trying to do in the workbook. -- Vasant "Wildman" wrote in message ... Does anyone has a way to put a clock in a cell that runs while the spreadsheets open? is that possible? (I've seen the awesome clock on Pearson's wonderful sight but I just need a digital clock in one cell to calculate formulas in other cells) Thanks in advance Wildman |
#3
|
|||
|
|||
Here is another approach as Vasant suggests.
First create workbook names for 3 cells, say A1, of clock, and format the cell as hh:mm:ss. Add the code below to the modules indicated, and start the closck by running the following code Set timer = Range("clock") StartClock To stop the closck, just run the StopClock macro. '--------------------------------------------------------------------------- ------ In one code module add this code Option Explicit Private Declare Function FindWindow Lib "user32" _ Alias "FindWindowA" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Declare Function SetTimer Lib "user32" _ (ByVal hWnd As Long, _ ByVal nIDEvent As Long, _ ByVal uElapse As Long, _ ByVal lpTimerFunc As Long) As Long Private Declare Function KillTimer Lib "user32" _ (ByVal hWnd As Long, _ ByVal nIDEvent As Long) As Long Public timer As Range Private WindowsTimer As Long Public Function cbkRoutine(ByVal Window_hWnd As Long, _ ByVal WindowsMessage As Long, _ ByVal EventID As Long, _ ByVal SystemTime As Long) As Long Dim CurrentTime As String On Error Resume Next timer.Value = Format(Now, "Long Time") End Function Sub StartClock() timer.Value = Format(Now, "Long Time") fncWindowsTimer 1000, WindowsTimer '1 sec End Sub Sub StopClock() fncStopWindowsTimer End Sub Sub RestartClock() fncWindowsTimer 1000, WindowsTimer '1 sec End Sub Public Function fncWindowsTimer(TimeInterval As Long, WindowsTimer As Long) As Boolean WindowsTimer = 0 'if Excel2000 or above use the built-in AddressOf operator to 'get a pointer to the callback function If Val(Application.Version) 8 Then WindowsTimer = SetTimer(hWnd:=FindWindow("XLMAIN", Application.Caption), _ nIDEvent:=0, _ uElapse:=TimeInterval, _ lpTimerFunc:=AddrOf_Callback_Routine) Else 'use K.Getz & M.Kaplan function to get a pointer WindowsTimer = SetTimer(hWnd:=FindWindow("XLMAIN", Application.Caption), _ nIDEvent:=0, _ uElapse:=TimeInterval, _ lpTimerFunc:=AddrOf("cbkRoutine")) End If fncWindowsTimer = CBool(WindowsTimer) DoEvents End Function Public Function fncStopWindowsTimer() KillTimer hWnd:=FindWindow("XLMAIN", Application.Caption), _ nIDEvent:=0 'WindowsTimer End Function '--------------------------------------------------------------------------- ------ In another code module add this code Option Explicit Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _ Alias "EbGetExecutingProj" _ (hProject As Long) As Long Private Declare Function GetFuncID Lib "vba332.dll" _ Alias "TipGetFunctionId" _ (ByVal hProject As Long, _ ByVal strFunctionName As String, _ ByRef strFunctionID As String) As Long Private Declare Function GetAddr Lib "vba332.dll" _ Alias "TipGetLpfnOfFunctionId" _ (ByVal hProject As Long, _ ByVal strFunctionID As String, _ ByRef lpfnAddressOf As Long) As Long '--------------------------------------------------------------------------- - Public Function AddrOf(CallbackFunctionName As String) As Long '--------------------------------------------------------------------------- - 'AddressOf operator emulator for Office97 VBA 'Authors: Ken Getz and Michael Kaplan '--------------------------------------------------------------------------- - Dim aResult As Long Dim CurrentVBProject As Long Dim strFunctionID As String Dim AddressOfFunction As Long Dim UnicodeFunctionName As String 'convert the name of the function to Unicode system UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode) 'if the current VBProjects exists... If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then '...get the function ID of the callback function, based on its 'unicode-converted name, to ensure that it exists aResult = GetFuncID(hProject:=CurrentVBProject, _ strFunctionName:=UnicodeFunctionName, _ strFunctionID:=strFunctionID) 'if the function exists indeed ... If aResult = 0 Then '...get a pointer to the callback function based on 'the strFunctionID argument of the GetFuncID function aResult = GetAddr(hProject:=CurrentVBProject, _ strFunctionID:=strFunctionID, _ lpfnAddressOf:=AddressOfFunction) 'if we've got the pointer pass it to the result of the function If aResult = 0 Then AddrOf = AddressOfFunction End If End If End If End Function '--------------------------------------------------------------------------- - Public Function AddrOf_Callback_Routine() As Long '--------------------------------------------------------------------------- - 'Office97 VBE does not recognise the AddressOf operator; 'however, it does not raise a compile-error ... '--------------------------------------------------------------------------- - AddrOf_Callback_Routine = vbaPass(AddressOf cbkRoutine) End Function '--------------------------------------------------------------------------- - Private Function vbaPass(AddressOfFunction As Long) As Long '--------------------------------------------------------------------------- - vbaPass = AddressOfFunction End Function -- HTH RP (remove nothere from the email address if mailing direct) "Vasant Nanavati" <vasantn *AT* aol *DOT* com wrote in message ... Something like: Sub RunClock() Application.OnTime Now + TimeValue("00:00:01"), _ "UpdateClock" End Sub Sub UpdateClock() Range("A1") = Time RunClock End Sub I would recommend looking fo ranother approach, though, because this involves a macro that runs every second and may interfere with other things that you are trying to do in the workbook. -- Vasant "Wildman" wrote in message ... Does anyone has a way to put a clock in a cell that runs while the spreadsheets open? is that possible? (I've seen the awesome clock on Pearson's wonderful sight but I just need a digital clock in one cell to calculate formulas in other cells) Thanks in advance Wildman |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Start Clock/Stop Clock | Excel Discussion (Misc queries) | |||
Clock | Excel Discussion (Misc queries) | |||
conditional formatting 24-hour clock | Excel Worksheet Functions | |||
how do i work out how many hrs have passed in a 24 hr clock, in ex | Excel Worksheet Functions | |||
Clock | Excel Worksheet Functions |