Having problem with 2000 to 97 conversion

jfgambit · Apr 29, 2003

I have built a nice employee time tracking device in Excel 2000. It is pretty self explanitory ("IN" time, "OUT" time, total time, etc). What I am having problems with is the VB code that is behind the "OUT" time. In essence, once an "OUT" time is entered, the ms error message box is overwritten to ask what type of break the person took (No Lunch, 1/2 hour, 1 hour) and takes the response and implements it into the Total hours calculation. Works great in 2000, but the users are getting problems in 97. i don't have 97 and can't seem to trouble shoot it. Could some guru with 97 have a look at this and see what exactly I am missing in 97.

The code is a manipulation of Ken Getz's brilliance by Stratos. Which can be viewed at the following: http://groups.google.com/groups?hl=en&lr=&ie=UTF-8&oe=UTF-8&selm=39D37A29.99BF2A63@csv.warwick.ac.uk

If anyone can help, please let me know and I can send you a copy of the Excel sheet. Really appreciate the help.

THANKS.

Thanks for any help

Ivan F Moala · May 1, 2003

How have you implimented this in Xl97 ??
A workbook would be handy.....

jfgambit · May 1, 2003

Ivan:

I orginally wrote:

If anyone can help, please let me know and I can send you a copy of the Excel sheet. Really appreciate the help.

Unfortunately, the file is 678K zipped and I cannot attach it to the board due to size limitations. I can send you a copy if you give me an e-mail address. PM me if you do not want it publically displayed.

Thanks

Ivan F Moala · May 6, 2003

Hi below the posts you will see an email icon
Use this to email me the workbook..........

NateO · May 6, 2003

Hello,

jfgambit said:
I have built a nice employee time tracking device in Excel 2000. It is pretty self explanitory ("IN" time, "OUT" time, total time, etc).

Alright, here's the origination of this quandary, just so that readers know what the issue is, it's addressof, and I don't have the correct .dll to test/work with Mr. Getz's workaround.

I still stick with my follow-up advice:

I didn't steer you down this road with '97 in mind originally, had I known that's what you're using, I might have recommended something else... (Userform)

I think you should create and use a userform. This gets messy, even if you have '97 you still may or may not have the correct .dll file, you almost need to run a file search, which is not going to be efficient...

I'm quite certain Ivan can help, he is a guru, perhaps he has the correct .dll. If you don't want to mess with it Ivan, I'll take the file @

Nate@TheOfficeExpertsNoSpam.com (remove NoSpam) and impliment a userform approach.

Although, I would like to see a functioning variety of this with respect to Excel '97 as I can't test it, without downloading the file (which I should possibly purse...).

Ivan F Moala · May 6, 2003

NateO said:
Hello,

jfgambit said:

I have built a nice employee time tracking device in Excel 2000. It is pretty self explanitory ("IN" time, "OUT" time, total time, etc).

Click to expand...

Alright, here's the origination of this mess/quandary, just so that readers know what the issue is, it's addressof, and I don't have the correct .dll to test/work with Mr. Getz's workaround.

I still stick with my follow-up advice:

I didn't steer you down this road with '97 in mind originally, had I known that's what you're using, I might have recommended something else... (Userform)

Click to expand...

I think you should create and use a userform. This gets messy, even if you have '97 you may have differing .dll files, you almost need to run a file search, which is not going to be efficient...

I'm quite certain Ivan can help, he is a guru, perhaps he has the correct .dll. If you don't want to mess with it Ivan, I'll take the file @

Nate@TheOfficeExpertsNoSpam.com (remove NoSpam).

Although, I would like to see a functioning variety of this with respect to Excel '97 as I can't test it, without downloading the file (which I should possibly purse...).

Hi NateO
How are you

If he emails me I can have a look...but from a quick look I think
all he needs to do is Find the DLL and explicitly set the Function path to this
eg

Private Declare Function GetCurrentVbaProject Lib "C:\etc\etc\vba332.dll" _

NateO · May 6, 2003

Hello Ivan,

Ivan F Moala said:
Hi NateO
How are you
If he emails me I can have a look...but from a quick look I think
all he needs to do is Find the DLL and explicitly set the Function path to this
eg

Private Declare Function GetCurrentVbaProject Lib "C:\etc\etc\vba332.dll" _

Doing well, thanks! You?

That was my thought in the linked post, I just can't test it.... Api by eyesight, interesting...

While api calls are efficient, the quandary involves a worksheet change event, and, apparently used by both xl '97 and '00 users, so it'll need both the customized workaround and the vb =>6 addressof function. I'm certain it's possible, but is it worth it....?

Still, interested though. Hope all is well with you.

jfgambit · May 6, 2003

Nate and Ivan:

Sorry I have not replied, and it's nice to see that someone was still looking at this. i have been building an HR tracking database and dealing with some a new SAP/Oracle data warehousing problem and just recently heard from the individual having problems.

First off, Nate in no way did I not appreciate your help, but since you quoted that you could not help since you did not have 97 then i turned to an alternate source.

With that said the individual using the Excel sheet sent me the Debugging that occured when openning the sheet. The following line was highlighted for debugging:

Dim mbFlags As VbMsgBoxStyle

Ivan. I will send you a copy of the excel sheet. I have checked the references and ran the following as suggest by Nate:

Sub test()
Dim test As VbMsgBoxStyle, Z As Long
MsgBox VarType(test)
MsgBox VarType(Z)
End Sub

Problem is I have 2000 and the individual using this is not that advanced to help with the debugging. Sending something back and forth and asking him to check things only confuses him.

So any help would be greatly appreciated.

Nate and Ivan...again thanks for the time and effort into looking into this.

Ivan F Moala · May 7, 2003

OK, I got it to work....you were missing
1) The Actuall Function call
2) Addressof function wasn't called properly
3) I had use use Interger consts in place of std VbMsgboxstyles ??

'NOTE: The brilliant AddrOf function herein contained is the work of Ken Getz and
'Michael Kaplan. Published in the May 1998 issue of
'Microsoft Office & Visual Basic for Applications Developer (page 46).

'Office 97 does not support the "AddressOf" operator which is needed to tell Windows
'where our "call back" function is. Getz and Kaplan figured out a workaround.

Any way here is what I got to Work

Option Explicit

Private Const MB_YESNOCANCEL = &H3&
Private Const MB_YESNO = &H4&
Private Const MB_RETRYCANCEL = &H5&
Private Const MB_OKCANCEL = &H1&
Private Const MB_OK = &H0&
Private Const MB_ABORTRETRYIGNORE = &H2&
Private Const MB_ICONEXCLAMATION = &H30&
Private Const MB_ICONQUESTION = &H20&
Private Const MB_ICONASTERISK = &H40&
Private Const MB_ICONINFORMATION = MB_ICONASTERISK
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
Private Const IDPROMPT = &HFFFF&
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5

Private Type MSGBOX_HOOK_PARAMS
 hwndOwner As Long
 hHook As Long
End Type

Private MSGHOOK As MSGBOX_HOOK_PARAMS

Private Declare Function GetCurrentThreadId _
 Lib "kernel32" () _
As Long

Private Declare Function GetDesktopWindow Lib _
 "user32" () _
As Long

Private Declare Function GetWindowLong _
 Lib "user32" _
 Alias "GetWindowLongA" ( _
 ByVal hwnd As Long, _
 ByVal nIndex As Long) _
As Long

Private Declare Function MessageBox _
 Lib "user32" _
 Alias "MessageBoxA" ( _
 ByVal hwnd As Long, _
 ByVal lpText As String, _
 ByVal lpCaption As String, _
 ByVal wType As Long) _
As Long

Private Declare Function SetDlgItemText _
 Lib "user32" _
 Alias "SetDlgItemTextA" ( _
 ByVal hDlg As Long, _
 ByVal nIDDlgItem As Long, _
 ByVal lpString As String) _
As Long

Private Declare Function SetWindowsHookEx _
 Lib "user32" _
 Alias "SetWindowsHookExA" ( _
 ByVal idHook As Long, _
 ByVal lpfn As Long, _
 ByVal hmod As Long, _
 ByVal dwThreadId As Long) _
As Long

Private Declare Function SetWindowText _
 Lib "user32" _
 Alias "SetWindowTextA" ( _
 ByVal hwnd As Long, _
 ByVal lpString As String) _
As Long

Private Declare Function UnhookWindowsHookEx _
 Lib "user32" ( _
 ByVal hHook As Long) _
As Long

Dim mbFlags As Integer 'VbMsgBoxS
Dim mbFlags2 As Integer 'VbMsgBoxS
Dim mTitle As String
Dim mPrompt As String
Dim But1 As String
Dim But2 As String
Dim But3 As String

Public y As Double

Private Function MessageBoxH(hwndThreadOwner As Long, _
 hwndOwner As Long, mbFlags As Integer) As Long

'This function calls the hook
Dim hInstance As Long
Dim hThreadId As Long

hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()

With MSGHOOK
 .hwndOwner = hwndOwner
 .hHook = SetWindowsHookEx(WH_CBT, AddrOf("MsgBoxHookProc"), hInstance, hThreadId)
End With

MessageBoxH = MessageBox(hwndOwner, Space$(120), Space$(120), mbFlags)

End Function

Public Function MsgBoxHookProc(ByVal uMsg As Long, _
 ByVal wParam As Long, ByVal lParam As Long) As Long

'This function catches the messagebox before it opens
'and changes the text of the buttons - then removes the hook

If uMsg = HCBT_ACTIVATE Then
 SetWindowText wParam, mTitle
 SetDlgItemText wParam, IDPROMPT, mPrompt
 Select Case mbFlags
 Case vbAbortRetryIgnore
 SetDlgItemText wParam, IDABORT, But1
 SetDlgItemText wParam, IDRETRY, But2
 SetDlgItemText wParam, IDIGNORE, But3
 Case vbYesNoCancel
 SetDlgItemText wParam, IDYES, But1
 SetDlgItemText wParam, IDNO, But2
 SetDlgItemText wParam, IDCANCEL, But3
 Case vbOKOnly
 SetDlgItemText wParam, IDOK, But1
 Case vbRetryCancel
 SetDlgItemText wParam, IDRETRY, But1
 SetDlgItemText wParam, IDCANCEL, But2
 Case vbYesNo
 SetDlgItemText wParam, IDYES, But1
 SetDlgItemText wParam, IDNO, But2
 Case vbOKCancel
 SetDlgItemText wParam, IDOK, But1
 SetDlgItemText wParam, IDCANCEL, But2
 End Select
 UnhookWindowsHookEx MSGHOOK.hHook
End If

MsgBoxHookProc = False

End Function

Private Function BBmsgbox(mhwnd As Long, _
 mMsgbox As Integer, _
 Title As String, _
 Prompt As String, _
 Optional mMsgIcon As Integer, _
 Optional ButA As String, _
 Optional ButB As String, _
 Optional ButC As String) _
As String

'This function sets your custom parameters and returns
'which button was pressed as a string
Dim mReturn As Long

mbFlags = mMsgbox
mbFlags2 = mMsgIcon
mTitle = Title
mPrompt = Prompt
But1 = ButA
But2 = ButB
But3 = ButC
mReturn = MessageBoxH(mhwnd, GetDesktopWindow(), mbFlags Or mbFlags2)

Select Case mReturn
 Case IDABORT
 BBmsgbox = But1
 Case IDRETRY
 BBmsgbox = But2
 Case IDIGNORE
 BBmsgbox = But3
 Case IDYES
 BBmsgbox = But1
 Case IDNO
 BBmsgbox = But2
 Case IDCANCEL
 BBmsgbox = But3
 Case IDOK
 BBmsgbox = But1
End Select

End Function

Private Sub PrmptUserTest()
Dim mReturn As String

mReturn = BBmsgbox(1, vbYesNoCancel, _
 "Enter Your Break", "Please enter a lunch break: " & _
 " 0 = No, 1 = 1/2 hour, 2 = 1 hour", vbInformation, "0", "1", "2")
Select Case mReturn
 Case Is = "0"
 y = 0
 Case Is = "1"
 y = 0.5
 Case Is = "2"
 y = 1
End Select

MsgBox "mReturn:= " & mReturn & vbCr & " Lunch break:=" & y & " hr TOO LONG!"

End Sub

Private Function AddrOf(CallbackFunctionName As String) As Long

Dim aResult As Long, CurrentVBProject As Long, strFunctionId As String
Dim AddressofFunction As Long, UniCbkFunctionName As String

UniCbkFunctionName = StrConv(CallbackFunctionName, vbUnicode)

If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then
 aResult = GetFuncID(hProject:=CurrentVBProject, _
 strFunctionName:=UniCbkFunctionName, _
 strFunctionId:=strFunctionId)
 If aResult = 0 Then
 aResult = GetAddr(CurrentVBProject, _
 strFunctionId, lpfn:=AddressofFunction)
 If aResult = 0 Then
 AddrOf = AddressofFunction
 End If
 End If
End If

End Function


The Actual Function calls that were missing

Public Declare Function GetCurrentVbaProject _
 Lib "vba332.dll" _
 Alias "EbGetExecutingProj" ( _
 hProject As Long) _
As Long

Public Declare Function GetFuncID _
 Lib "vba332.dll" _
 Alias "TipGetFunctionId" ( _
 ByVal hProject As Long, _
 ByVal strFunctionName As String, _
 ByRef strFunctionId As String) _
As Long

Public Declare Function GetAddr _
 Lib "vba332.dll" _
 Alias "TipGetLpfnOfFunctionId" ( _
 ByVal hProject As Long, _
 ByVal strFunctionId As String, _
 ByRef lpfn As Long) _
As Long

'-------------------------------------------------------------------------------------------------------------------
' AddrOf
'
' Returns a function pointer of a VBA public function given its name. This function
' gives similar functionality to VBA as VB5 has with the AddressOf param type.
'
' NOTE: This function only seems to work if the proc you are trying to get a pointer
' to is in the current project. This makes sense, since we are using a function
' named EbGetExecutingProj.
'-------------------------------------------------------------------------------------------------------------------
Public Function AddrOf(strFuncName As String) As Long
 Dim hProject As Long
 Dim lngResult As Long
 Dim strID As String
 Dim lpfn As Long
 Dim strFuncNameUnicode As String

 Const NO_ERROR = 0

 ' The function name must be in Unicode, so convert it.
 strFuncNameUnicode = StrConv(strFuncName, vbUnicode)

 ' Get the current VBA project
 ' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
 ' so now we just check the project handle when the function returns.
 Call GetCurrentVbaProject(hProject)

 ' Make sure we got a project handle... we always should, but you never know!
 If hProject <> 0 Then
 ' Get the VBA function ID (whatever that is!)
 lngResult = GetFuncID( _
 hProject, strFuncNameUnicode, strID)

 ' We have to check this because we GPF if we try to get a function pointer
 ' of a non-existent function.
 If lngResult = NO_ERROR Then
 ' Get the function pointer.
 lngResult = GetAddr(hProject, strID, lpfn)

 If lngResult = NO_ERROR Then
 AddrOf = lpfn
 End If
 End If
 End If
End Function


I'll send the workbook

jfgambit · May 7, 2003

Ivan:

Thanks! I look forward to reviewing the spreadsheet and your updates.

Thank you both for your time in regards to this matter.

Jeff

Having problem with 2000 to 97 conversion

jfgambit

New Member

Excel Facts

Ivan F Moala

MrExcel MVP

jfgambit

New Member

Ivan F Moala

MrExcel MVP

NateO

Legend

Ivan F Moala

MrExcel MVP

NateO

Legend

jfgambit

New Member

Ivan F Moala

MrExcel MVP

jfgambit

New Member

Similar threads

Forum statistics

Share this page

Having problem with 2000 to 97 conversion

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

Legend

MrExcel MVP

Legend

New Member

MrExcel MVP

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock