#1   Report Post  
Old May 22nd 05, 05:41 PM
mully
 
Posts: n/a
Default Date & Time

Hi

Is there a code I can insert in VBA that will constantly update - the time
and date in two separate text boxes on a User Form. That I use now - I know
how to insert the text boxes on the User Form in Excel. The dates would have
to be in UK format.

Cheers

Mully



  #2   Report Post  
Old May 22nd 05, 06:41 PM
Bob Phillips
 
Posts: n/a
Default

Hi Mully,

Here is some code. There is code for the userform, and some for 2 code
modules

Add this code to the userform

Private Sub Userform_Initialize()
Set timer = TextBox1
Set dater = TextBox2
StartClock
End Sub



'-----------------------------*------------------------------*--------------
'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, dater

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")
dater.Value = Format(Date, "dd/mm/yyyy")
End Function


Sub StartClock()
timer.Value = Format(Time, "Long Time")
dater.Value = Format(Date, "dd/mm/yyyy")
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(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)


"mully" wrote in message
...
Hi

Is there a code I can insert in VBA that will constantly update - the time
and date in two separate text boxes on a User Form. That I use now - I

know
how to insert the text boxes on the User Form in Excel. The dates would

have
to be in UK format.

Cheers

Mully




  #3   Report Post  
Old May 22nd 05, 06:59 PM
mully
 
Posts: n/a
Default

Hi Bob

Thanks again but this is to long for me tonight been at it since about
11-00am - fortunately the customer I'm doing this for is still in Cardiff
drowning his sorrows so Tuesday pm will be ok - will get going early
tomorrow. Have up dated the local clubs web site - just a small site but it
suits them another job I do Club Sec and if you get me going about pigeons
we'll still be at it a month from now. So enough is enough for today - speak
to you soon.

http://pigeonsglossop.mysite.wanadoo-members.co.uk/

Cheers again ------ Mully

"Bob Phillips" wrote:

Hi Mully,

Here is some code. There is code for the userform, and some for 2 code
modules

Add this code to the userform

Private Sub Userform_Initialize()
Set timer = TextBox1
Set dater = TextBox2
StartClock
End Sub



'-----------------------------*------------------------------*--------------
'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, dater

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")
dater.Value = Format(Date, "dd/mm/yyyy")
End Function


Sub StartClock()
timer.Value = Format(Time, "Long Time")
dater.Value = Format(Date, "dd/mm/yyyy")
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(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)


"mully" wrote in message
...
Hi

Is there a code I can insert in VBA that will constantly update - the time
and date in two separate text boxes on a User Form. That I use now - I

know
how to insert the text boxes on the User Form in Excel. The dates would

have
to be in UK format.

Cheers

Mully





  #4   Report Post  
Old May 23rd 05, 11:23 AM
mully
 
Posts: n/a
Default

Hi Bob

Thought I'd set up a new user form and try out the code you sent - been at
it about an 2 hours now - got the user form set up inserted the code as you
suggested however no joy shows the date and time in the text boxes but the
time is constant at 00:00:00 - tried changing the date in control panel that
remains the same as set at 23/05/2005 - Below code I set up Is it OK????

Private Sub TextBox1_Change()

TextBox1.Text = Worksheets("Sheet1").Range("A1").Text

End Sub

Private Sub TextBox2_Change()


TextBox2.Text = Worksheets("Sheet1").Range("B1").Text

End Sub

Private Sub Userform_Initialize()
Set timer = TextBox1
Set dater = TextBox2
StartClock
End Sub

Inserted 2 other modules and put the code on them as you recommended -
still trying or 'am I very trying??

Cheers ----- Mully

"mully" wrote:

Hi Bob

Thanks again but this is to long for me tonight been at it since about
11-00am - fortunately the customer I'm doing this for is still in Cardiff
drowning his sorrows so Tuesday pm will be ok - will get going early
tomorrow. Have up dated the local clubs web site - just a small site but it
suits them another job I do Club Sec and if you get me going about pigeons
we'll still be at it a month from now. So enough is enough for today - speak
to you soon.

http://pigeonsglossop.mysite.wanadoo-members.co.uk/

Cheers again ------ Mully

"Bob Phillips" wrote:

Hi Mully,

Here is some code. There is code for the userform, and some for 2 code
modules

Add this code to the userform

Private Sub Userform_Initialize()
Set timer = TextBox1
Set dater = TextBox2
StartClock
End Sub



'-----------------------------*------------------------------*--------------
'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, dater

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")
dater.Value = Format(Date, "dd/mm/yyyy")
End Function


Sub StartClock()
timer.Value = Format(Time, "Long Time")
dater.Value = Format(Date, "dd/mm/yyyy")
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(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)


"mully" wrote in message
...
Hi

Is there a code I can insert in VBA that will constantly update - the time
and date in two separate text boxes on a User Form. That I use now - I

know
how to insert the text boxes on the User Form in Excel. The dates would

have
to be in UK format.

Cheers

Mully





  #5   Report Post  
Old May 23rd 05, 11:56 AM
mully
 
Posts: n/a
Default

Hi Bob

Ignore previous got it working perfectly

Cheers ---------- Mully

"mully" wrote:

Hi Bob

Thought I'd set up a new user form and try out the code you sent - been at
it about an 2 hours now - got the user form set up inserted the code as you
suggested however no joy shows the date and time in the text boxes but the
time is constant at 00:00:00 - tried changing the date in control panel that
remains the same as set at 23/05/2005 - Below code I set up Is it OK????

Private Sub TextBox1_Change()

TextBox1.Text = Worksheets("Sheet1").Range("A1").Text

End Sub

Private Sub TextBox2_Change()


TextBox2.Text = Worksheets("Sheet1").Range("B1").Text

End Sub

Private Sub Userform_Initialize()
Set timer = TextBox1
Set dater = TextBox2
StartClock
End Sub

Inserted 2 other modules and put the code on them as you recommended -
still trying or 'am I very trying??

Cheers ----- Mully

"mully" wrote:

Hi Bob

Thanks again but this is to long for me tonight been at it since about
11-00am - fortunately the customer I'm doing this for is still in Cardiff
drowning his sorrows so Tuesday pm will be ok - will get going early
tomorrow. Have up dated the local clubs web site - just a small site but it
suits them another job I do Club Sec and if you get me going about pigeons
we'll still be at it a month from now. So enough is enough for today - speak
to you soon.

http://pigeonsglossop.mysite.wanadoo-members.co.uk/

Cheers again ------ Mully

"Bob Phillips" wrote:

Hi Mully,

Here is some code. There is code for the userform, and some for 2 code
modules

Add this code to the userform

Private Sub Userform_Initialize()
Set timer = TextBox1
Set dater = TextBox2
StartClock
End Sub



'-----------------------------*------------------------------*--------------
'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, dater

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")
dater.Value = Format(Date, "dd/mm/yyyy")
End Function


Sub StartClock()
timer.Value = Format(Time, "Long Time")
dater.Value = Format(Date, "dd/mm/yyyy")
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(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)


"mully" wrote in message
...
Hi

Is there a code I can insert in VBA that will constantly update - the time
and date in two separate text boxes on a User Form. That I use now - I
know
how to insert the text boxes on the User Form in Excel. The dates would
have
to be in UK format.

Cheers

Mully







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
Automatically enter date and time but only update once. PM New Users to Excel 3 January 21st 05 07:47 AM
Help - Information with time and date PM Excel Discussion (Misc queries) 4 January 6th 05 08:25 AM
Combined date time cell to separate date & time components Mark Ada Excel Discussion (Misc queries) 1 December 2nd 04 02:48 AM
Combined date time cell to separate date & time components Mark Ada Excel Discussion (Misc queries) 1 December 2nd 04 12:07 AM
Combined date time cell to separate date & time components Mark Ada Excel Worksheet Functions 1 December 2nd 04 12:04 AM


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

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

About Us

"It's about Microsoft Excel"

 

Copyright © 2017