Home |
Search |
Today's Posts |
#1
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can Excel automatically insert current date in a cell? | Excel Worksheet Functions | |||
Combining date and time into one cell | Excel Discussion (Misc queries) | |||
Automatically enter date and time but only update once. | New Users to Excel | |||
cell assumes wrong date | Setting up and Configuration of Excel | |||
Using formulas to determine date in one cell based on date in anot | Excel Worksheet Functions |