Re: current date and time object

Tech-Archive recommends: Fix windows errors by optimizing your registry

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
>>
>>
>
>


.

Quantcast