#1   Report Post  
Wildman
 
Posts: n/a
Default 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   Report Post  
Vasant Nanavati
 
Posts: n/a
Default

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   Report Post  
Bob Phillips
 
Posts: n/a
Default

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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Start Clock/Stop Clock abfabrob Excel Discussion (Misc queries) 9 June 28th 05 04:26 PM
Clock Marcel Excel Discussion (Misc queries) 2 April 4th 05 09:45 PM
conditional formatting 24-hour clock snitz Excel Worksheet Functions 3 March 27th 05 01:41 PM
how do i work out how many hrs have passed in a 24 hr clock, in ex excelious Excel Worksheet Functions 2 March 10th 05 12:51 PM
Clock lehigh46 Excel Worksheet Functions 1 February 4th 05 02:28 PM


All times are GMT +1. The time now is 10:10 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"