Re: current date and time object

Hi Bob,

Got it. Works fine. Doesn't show the date though - can I modify the code to
do that? I'll try moving it to my *** here in a minute...

Thanks!

--Randy

"Bob Phillips" <bob.phillips@xxxxxxxxxxxxxxxxxxxx> wrote in message
news:%23ZX$gwf4FHA.2676@xxxxxxxxxxxxxxxxxxxxxxx
> Hi Randy,
>
> I have posted it at http://cjoint.com/?lfmBZ4LZiH
>
> I don't have 2003 so I couldn't test it with that, but there is nothing
> there that should stop it. Let me know how it goes.
>
>
> Bob
>
> "Randy Starkey" <randy.starkeyNOSPAM@xxxxxxxxxxxxxxxxxxxxxxx> wrote in
> message news:11moaqvlcbtjff6@xxxxxxxxxxxxxxxxxxxxx
>> Bob,
>>
>> That would be perfect! I would think I can get it from there.
>>
>> Thanks,
>>
>> --Randy
>>
>>
>>
>>
>>
>>
>> "Bob Phillips" <bob.phillips@xxxxxxxxxxxxxxxxxxxx> wrote in message
>> news:e$myccW4FHA.1416@xxxxxxxxxxxxxxxxxxxxxxx
>> > No, it was supposed tom be compatible for both, but there is special
> code
>> > for 97. If you have 2003 it should be fine. Shall I post an example
>> > workbook
>> > to the web which you can download and see it working?
>> >
>> > --
>> >
>> > HTH
>> >
>> > RP
>> > (remove nothere from the email address if mailing direct)
>> >
>> >
>> > "Randy Starkey" <randy.starkeyNOSPAM@xxxxxxxxxxxxxxxxxxxxxxx> wrote in
>> > message news:11mn5te5m5bfa78@xxxxxxxxxxxxxxxxxxxxx
>> >> Bob,
>> >>
>> >> OK. I'm actually running Excel 2003 though. I guess you mean this was
>> >> composed in 97? Anyway, thanks for all the help!
>> >>
>> >> --Randy
>> >>
>> >> "Bob Phillips" <bob.phillips@xxxxxxxxxxxxxxxxxxxx> wrote in message
>> >> news:Ogf2osR4FHA.2524@xxxxxxxxxxxxxxxxxxxxxxx
>> >> > Randy,
>> >> >
>> >> > I'll fire up 97 and try it later.
>> >> >
>> >> > --
>> >> >
>> >> > HTH
>> >> >
>> >> > RP
>> >> > (remove nothere from the email address if mailing direct)
>> >> >
>> >> >
>> >> > "Randy Starkey" <randy.starkeyNOSPAM@xxxxxxxxxxxxxxxxxxxxxxx> wrote
> in
>> >> > message news:11mlqh0glh5641b@xxxxxxxxxxxxxxxxxxxxx
>> >> >> Hi Bob,
>> >> >>
>> >> >> Got a variable not defined compile error here...
>> >> >>
>> >> >> Public Function fncWindowsTimer(TimeInterval As Long) As Boolean
>> >> >> Dim WindowsTimer As Long
>> >> >> WindowsTimer = 0
>> >> >> 'if we are in 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_cbkCustomTimer)
>> >> >>
>> >> >> last line was highlighted in gray, first line in yellow.
>> >> >>
>> >> >> Thanks,
>> >> >>
>> >> >> --Randy
>> >> >>
>> >> >>
>> >> >>
>> >> >>
>> >> >> "Bob Phillips" <bob.phillips@xxxxxxxxxxxxxxxxxxxx> wrote in message
>> >> >> news:%234ymQiM4FHA.1420@xxxxxxxxxxxxxxxxxxxxxxx
>> >> >> > Randy,
>> >> >> >
>> >> >> > Try splitting it over 2 modules.
>> >> >> >
>> >> >> > Add this to the first
>> >> >> >
>> >> >> > Option Explicit
>> >> >> >
>> >> >> > Sub StartClock()
>> >> >> > Range("clock").Value = Format(Now, "Long Time")
>> >> >> > fncWindowsTimer 1000
>> >> >> > End Sub
>> >> >> >
>> >> >> > Sub StopClock()
>> >> >> > fncStopWindowsTimer
>> >> >> > End Sub
>> >> >> >
>> >> >> > Public Function AddrOf_cbkCustomTimer() As Long
>> >> >> > 'Office97 VBE does not recognise the AddressOf operator;
>> >> >> > 'however, it does not raise a compile-error either...
>> >> >> > AddrOf_cbkCustomTimer = vbaPass(AddressOf cbkCustomTimer)
>> >> >> > End Function
>> >> >> >
>> >> >> > Private Function vbaPass(AddressOfFunction As Long) As Long
>> >> >> > vbaPass = AddressOfFunction
>> >> >> > End Function
>> >> >> >
>> >> >> >
>> >> >> > and this to another
>> >> >> >
>> >> >> > 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
>> >> >> >
>> >> >> >
>> >> >> > 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
>> >> >> >
>> >> >> >
>> >> >> > Private WindowsTimer As Long
>> >> >> >
>> >> >> >
>> >> >> >
>> >> >> > Public Function fncWindowsTimer(TimeInterval As Long) As Boolean
>> >> >> > Dim WindowsTimer As Long
>> >> >> > WindowsTimer = 0
>> >> >> > 'if we are in 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_cbkCustomTimer)
>> >> >> > Else 'use K.Getz & M.Kaplan function to get a pointer
>> >> >> > WindowsTimer = SetTimer(hWnd:=FindWindow("XLMAIN", _
>> >> >> > Application.Caption), _
>> >> >> > nIDEvent:=0, _
>> >> >> > uElapse:=TimeInterval, _
>> >> >> >
>> >> >> > lpTimerFunc:=AddrOf("cbkCustomTimer"))
>> >> >> > End If
>> >> >> > fncWindowsTimer = CBool(WindowsTimer)
>> >> >> > End Function
>> >> >> >
>> >> >> >
>> >> >> > Public Function fncStopWindowsTimer()
>> >> >> > KillTimer hWnd:=FindWindow("XLMAIN", Application.Caption), _
>> >> >> > nIDEvent:=WindowsTimer
>> >> >> > End Function
>> >> >> >
>> >> >> >
>> >> >> > Public Function cbkCustomTimer(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
>> >> >> > Range("clock").Value = Format(Now, "Long Time")
>> >> >> > End Function
>> >> >> >
>> >> >> >
>> >> >> > Public Function AddrOf(CallbackFunctionName As String) As Long
>> >> >> > 'AddressOf operator replacement for Office97 VBA
>> >> >> > 'Authors: Ken Getz and Michael Kaplan
>> >> >> > '
>> >> >> > 'declaration of local variables
>> >> >> > 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, in order 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
>> >> >> >
>> >> >> >
>> >> >> > --
>> >> >> >
>> >> >> > HTH
>> >> >> >
>> >> >> > RP
>> >> >> > (remove nothere from the email address if mailing direct)
>> >> >> >
>> >> >> >
>> >> >> > "Randy Starkey" <randy.starkeyNOSPAM@xxxxxxxxxxxxxxxxxxxxxxx>
> wrote
>> > in
>> >> >> > message news:11mj8f03tt3nfa9@xxxxxxxxxxxxxxxxxxxxx
>> >> >> >> Bob,
>> >> >> >>
>> >> >> >> Error on compile... AddressOf wouldn't compile. In this section.
>> >> >> >> Cell after this error showed time, no date, and the time was
> frozen
>> > at
>> >> >> >> the
>> >> >> >> time of the macro execution.
>> >> >> >>
>> >> >> >> Private Function AddrOf_cbkCustomTimer() As Long
>> >> >> >> 'Office97 VBE does not recognise the AddressOf operator;
>> >> >> >> 'however, it does not raise a compile-error either...
>> >> >> >> AddrOf_cbkCustomTimer = vbaPass(AddressOf cbkCustomTimer)
>> >> >> >> End Function
>> >> >> >>
>> >> >> >> Ideas?
>> >> >> >>
>> >> >> >> Thanks! --Randy
>> >> >> >>
>> >> >> >>
>> >> >> >>
>> >> >> >>
>> >> >> >> "Bob Phillips" <bob.phillips@xxxxxxxxxxxxxxxxxxxx> wrote in
> message
>> >> >> >> news:ew94Vw43FHA.1396@xxxxxxxxxxxxxxxxxxxxxxx
>> >> >> >> > Here is one example
>> >> >> >> >
>> >> >> >> > Just paste the code in a general code module, name a cell
> 'clock'
>> >> > (menu
>> >> >> >> > Insert>Name>Define) and then run the 'StartClock' macro.
>> >> >> >> >
>> >> >> >> > 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
>> >> >> >> >
>> >> >> >> >
>> >> >> >> > 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
>> >> >> >> >
>> >> >> >> >
>> >> >> >> > Private WindowsTimer As Long
>> >> >> >> >
>> >> >> >> >
>> >> >> >> > Sub StartClock()
>> >> >> >> > Range("clock").Value = Format(Now, "Long Time")
>> >> >> >> > fncWindowsTimer 1000
>> >> >> >> > End Sub
>> >> >> >> > Sub StopClock()
>> >> >> >> > fncStopWindowsTimer
>> >> >> >> > End Sub
>> >> >> >> >
>> >> >> >> >
>> >> >> >> > Private Function fncWindowsTimer(TimeInterval As Long) As
> Boolean
>> >> >> >> > Dim WindowsTimer As Long
>> >> >> >> > WindowsTimer = 0
>> >> >> >> > 'if we are in 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_cbkCustomTimer)
>> >> >> >> > Else 'use K.Getz & M.Kaplan function to get a pointer
>> >> >> >> > WindowsTimer = SetTimer(hWnd:=FindWindow("XLMAIN", _
>> >> >> >> > Application.Caption), _
>> >> >> >> > nIDEvent:=0, _
>> >> >> >> > uElapse:=TimeInterval, _
>> >> >> >> >
>> >> >> >> > lpTimerFunc:=AddrOf("cbkCustomTimer"))
>> >> >> >> > End If
>> >> >> >> > fncWindowsTimer = CBool(WindowsTimer)
>> >> >> >> > End Function
>> >> >> >> >
>> >> >> >> >
>> >> >> >> > Private Function fncStopWindowsTimer()
>> >> >> >> > KillTimer hWnd:=FindWindow("XLMAIN", Application.Caption),
>> >> >> >> > _
>> >> >> >> > nIDEvent:=WindowsTimer
>> >> >> >> > End Function
>> >> >> >> >
>> >> >> >> >
>> >> >> >> > Private Function cbkCustomTimer(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
>> >> >> >> > Range("clock").Value = Format(Now, "Long Time")
>> >> >> >> > End Function
>> >> >> >> >
>> >> >> >> >
>> >> >> >> > Private Function AddrOf(CallbackFunctionName As String) As
>> >> >> >> > Long
>> >> >> >> > 'AddressOf operator replacement for Office97 VBA
>> >> >> >> > 'Authors: Ken Getz and Michael Kaplan
>> >> >> >> > '
>> >> >> >> > 'declaration of local variables
>> >> >> >> > 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, in order 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
>> >> >> >> >
>> >> >> >> >
>> >> >> >> > Private Function AddrOf_cbkCustomTimer() As Long
>> >> >> >> > 'Office97 VBE does not recognise the AddressOf operator;
>> >> >> >> > 'however, it does not raise a compile-error either...
>> >> >> >> > AddrOf_cbkCustomTimer = vbaPass(AddressOf cbkCustomTimer)
>> >> >> >> > 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)
>> >> >> >> >
>> >> >> >> >
>> >> >> >> > "Randy Starkey" <randy.starkeyNOSPAM@xxxxxxxxxxxxxxxxxxxxxxx>
>> > wrote
>> >> > in
>> >> >> >> > message news:11mglldj2n714ea@xxxxxxxxxxxxxxxxxxxxx
>> >> >> >> >> Hi,
>> >> >> >> >>
>> >> >> >> >> Is there a way to have a current date and time box somewhere
> on
>> >> >> >> >> a
>> >> >> > ***?
>> >> >> >> >> I
>> >> >> >> >> know the =now() function does it in a cell, but it only
>> >> >> >> >> refreshes
>> >> >> >> >> on
>> >> >> >> >> macro
>> >> >> >> >> runs etc. I'm looking for something real time in the ***.
>> >> >> >> >>
>> >> >> >> >> Any ideas?
>> >> >> >> >>
>> >> >> >> >> Thanks!
>> >> >> >> >>
>> >> >> >> >> --Randy Starkey
>> >> >> >> >>
>> >> >> >> >>
>> >> >> >> >
>> >> >> >> >
>> >> >> >>
>> >> >> >>
>> >> >> >
>> >> >> >
>> >> >>
>> >> >>
>> >> >
>> >> >
>> >>
>> >>
>> >
>> >
>>
>>
>
>


.