Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Mark
 
Posts: n/a
Default Automatically up date time in a cell

Hi all,
I can enter the time in a cell by using the =now() and can update it by
hitting the F9 key but how can I make it change automatically to always
remain the same as the computer clock. I would imagine I need a macro to do
it ...can someone please help me.

Thanks....Mark
  #2   Report Post  
Mangesh Yadav
 
Posts: n/a
Default

check this thread....
http://www.excelforum.com/showthread.php?t=364995

Mangesh



"Mark" wrote in message
...
Hi all,
I can enter the time in a cell by using the =now() and can update it by
hitting the F9 key but how can I make it change automatically to always
remain the same as the computer clock. I would imagine I need a macro to

do
it ...can someone please help me.

Thanks....Mark



  #3   Report Post  
Bob Phillips
 
Posts: n/a
Default

Mark,

here is one way but it is not simple

Add the code below to the modules indicated, and start the clock by running
the following code


Set timer = Range("A1")
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(Time, "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("XLM*AIN",
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("XLM*AIN",
Application.Caption), _
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddrOf("cbkRoutin*e"))
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(CurrentVB*Project) = 0 Then
'...get the function ID of the callback function, based on its
'unicode-converted name, to ensure that it exists
aResult = GetFuncID(hProject:=CurrentVBP*roject, _
strFunctionName:=UnicodeFuncti*onName, _
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:=CurrentVBPro*ject, _
strFunctionID:=strFunctionID, _
lpfnAddressOf:=AddressOfFuncti*on)
'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

Bob Phillips

"Mark" wrote in message
...
Hi all,
I can enter the time in a cell by using the =now() and can update it by
hitting the F9 key but how can I make it change automatically to always
remain the same as the computer clock. I would imagine I need a macro to

do
it ...can someone please help me.

Thanks....Mark



  #4   Report Post  
Mangesh Yadav
 
Posts: n/a
Default

and one more...

http://www.mvps.org/dmcritchie/excel/datetime.htm

- Mangesh



"Mark" wrote in message
...
Hi all,
I can enter the time in a cell by using the =now() and can update it by
hitting the F9 key but how can I make it change automatically to always
remain the same as the computer clock. I would imagine I need a macro to

do
it ...can someone please help me.

Thanks....Mark



  #5   Report Post  
Peter Rooney
 
Posts: n/a
Default

Bob,

This is a great piece of code - except that I can get it to start, but I
can't get it to stop! No error messages are displayed, but the clock just
keeps on runnin' !

I'm running Excel 9.0.4402 SR1 on Windows 2000 5.00.2195 SP3

Any ideas?

Pete

"Bob Phillips" wrote:

Mark,

here is one way but it is not simple

Add the code below to the modules indicated, and start the clock by running
the following code


Set timer = Range("A1")
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(Time, "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("XLMÂ*AIN",
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("XLMÂ*AIN",
Application.Caption), _
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddrOf("cbkRoutinÂ*e"))
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(CurrentVBÂ*Project) = 0 Then
'...get the function ID of the callback function, based on its
'unicode-converted name, to ensure that it exists
aResult = GetFuncID(hProject:=CurrentVBPÂ*roject, _
strFunctionName:=UnicodeFunctiÂ*onName, _
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:=CurrentVBProÂ*ject, _
strFunctionID:=strFunctionID, _
lpfnAddressOf:=AddressOfFunctiÂ*on)
'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

Bob Phillips

"Mark" wrote in message
...
Hi all,
I can enter the time in a cell by using the =now() and can update it by
hitting the F9 key but how can I make it change automatically to always
remain the same as the computer clock. I would imagine I need a macro to

do
it ...can someone please help me.

Thanks....Mark






  #6   Report Post  
Dave Peterson
 
Posts: n/a
Default

It looks like when you run this sub:

Sub StopClock()

The clock should stop.

(Untested--but it makes sense from the name of the sub <bg.)



Peter Rooney wrote:

Bob,

This is a great piece of code - except that I can get it to start, but I
can't get it to stop! No error messages are displayed, but the clock just
keeps on runnin' !

I'm running Excel 9.0.4402 SR1 on Windows 2000 5.00.2195 SP3

Any ideas?

Pete

"Bob Phillips" wrote:

Mark,

here is one way but it is not simple

Add the code below to the modules indicated, and start the clock by running
the following code


Set timer = Range("A1")
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(Time, "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("XLMÂ*AIN",
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("XLMÂ*AIN",
Application.Caption), _
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddrOf("cbkRoutinÂ*e"))
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(CurrentVBÂ*Project) = 0 Then
'...get the function ID of the callback function, based on its
'unicode-converted name, to ensure that it exists
aResult = GetFuncID(hProject:=CurrentVBPÂ*roject, _
strFunctionName:=UnicodeFunctiÂ*onName, _
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:=CurrentVBProÂ*ject, _
strFunctionID:=strFunctionID, _
lpfnAddressOf:=AddressOfFunctiÂ*on)
'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

Bob Phillips

"Mark" wrote in message
...
Hi all,
I can enter the time in a cell by using the =now() and can update it by
hitting the F9 key but how can I make it change automatically to always
remain the same as the computer clock. I would imagine I need a macro to

do
it ...can someone please help me.

Thanks....Mark





--

Dave Peterson
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
Can Excel automatically insert current date in a cell? AdrianXing Excel Worksheet Functions 25 April 3rd 23 07:42 PM
Combining date and time into one cell Kelly C Excel Discussion (Misc queries) 3 July 9th 08 09:27 PM
Automatically enter date and time but only update once. PM New Users to Excel 3 January 21st 05 08:47 AM
cell assumes wrong date julie from Seattle Setting up and Configuration of Excel 1 November 30th 04 08:51 PM
Using formulas to determine date in one cell based on date in anot Gary Excel Worksheet Functions 2 November 22nd 04 09:11 AM


All times are GMT +1. The time now is 12:31 PM.

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"