在 64 位机器上使用宏时出现类型不匹配错误
Type mismatch error when macro is used with a 64 bit machine
我继承了一个嵌入在会计科目表中的宏。在 32 位机器上使用时效果很好。 64 位机器正在慢慢推出,用户在 64 位机器上使用宏时遇到问题。用户按下搜索按钮以显示弹出窗口 window。他们输入帐号并按 "find" 按钮,这会将他们带到他们输入的第一个实例。如果他们再次按下 "find",它将把他们带到第二个实例,依此类推。
我知道我必须在每个声明中输入 "ptrsafe",我已经这样做了。但是,我们现在在 MsgBoxEx 函数上遇到类型不匹配错误。 "AddressOf zWindowProc" 在此函数中突出显示。
任何人都可以帮助解决需要更改的内容吗?感谢您的帮助.........
Option Explicit
Public Enum ePosMsgBox
eTopLeft
eTopRight
eTopCentre
eBottomLeft
eBottomRight
eBottomCentre
eCentreScreen
eCentreDialog
End Enum
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal zlhHook As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe 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 PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Const GWL_HINSTANCE = (-6)
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private Const HCBT_ACTIVATE = 5
Private Const WH_CBT = 5
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long
Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private zlhHook As Long
Private zePosition As ePosMsgBox
Function MsgboxEx(Prompt As String, Optional Buttons As VbMsgBoxStyle, Optional Title, Optional HelpFile, Optional Context, Optional Position As ePosMsgBox) As VbMsgBoxResult
Dim lhInst As Long
Dim lThread As Long
lhInst = GetWindowLong(GetForegroundWindow, GWL_HINSTANCE)
lThread = GetCurrentThreadId()
zlhHook = SetWindowsHookEx(WH_CBT, AddressOf zWindowProc, lhInst, lThread)
zePosition = Position
MsgboxEx = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
End Function
Private Function zWindowProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tFormPos As RECT, tMsgBoxPos As RECT, tScreenWorkArea As RECT
Dim lLeft As Long, lTop As Long
Static sbRecursive As Boolean
If lMsg = HCBT_ACTIVATE Then
On Error Resume Next
tScreenWorkArea = ScreenWorkArea
GetWindowRect GetForegroundWindow, tFormPos
GetWindowRect wParam, tMsgBoxPos
Select Case zePosition
Case eCentreDialog
lLeft = (tFormPos.Left + (tFormPos.Right - tFormPos.Left) / 2) - ((tMsgBoxPos.Right - tMsgBoxPos.Left) / 2)
lTop = (tFormPos.Top + (tFormPos.Bottom - tFormPos.Top) / 2) - ((tMsgBoxPos.Bottom - tMsgBoxPos.Top) / 2)
Case eCentreScreen
lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2
lTop = ((tScreenWorkArea.Bottom - tScreenWorkArea.Top) - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)) / 2
Case eTopLeft
lLeft = tScreenWorkArea.Left
lTop = tScreenWorkArea.Top
Case eTopRight
lLeft = tScreenWorkArea.Right - (tMsgBoxPos.Right - tMsgBoxPos.Left)
lTop = tScreenWorkArea.Top
Case eTopCentre
lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2
lTop = tScreenWorkArea.Top
Case eBottomLeft
lLeft = tScreenWorkArea.Left
lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)
Case eBottomRight
lLeft = tScreenWorkArea.Right - (tMsgBoxPos.Right - tMsgBoxPos.Left)
lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)
Case eBottomCentre
lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2
lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)
End Select
If lLeft < 0 And sbRecursive = False Then
sbRecursive = True
zePosition = eCentreScreen
zWindowProc HCBT_ACTIVATE, wParam, lParam
sbRecursive = False
Exit Function
End If
SetWindowPos wParam, 0, lLeft, lTop, 10, 10, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
UnhookWindowsHookEx zlhHook
End If
zWindowProc = False
End Function
Function ScreenWorkArea() As RECT
Dim tScreen As RECT
Dim lRet As Long
Const SPI_GETWORKAREA = 48
lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, tScreen, 0)
ScreenWorkArea = tScreen
End Function
我能够解决我的问题。我在这个论坛的另一个问题中发现了这个 link,这对我帮助很大。我一行一行地为每个声明语句添加了 64 位版本,我还必须将几个变量更改为 64 位版本,它现在可以在 32 位或 64 位机器上运行。
http://www.cadsharp.com/docs/Win32API_PtrSafe.txt
我继承了一个嵌入在会计科目表中的宏。在 32 位机器上使用时效果很好。 64 位机器正在慢慢推出,用户在 64 位机器上使用宏时遇到问题。用户按下搜索按钮以显示弹出窗口 window。他们输入帐号并按 "find" 按钮,这会将他们带到他们输入的第一个实例。如果他们再次按下 "find",它将把他们带到第二个实例,依此类推。
我知道我必须在每个声明中输入 "ptrsafe",我已经这样做了。但是,我们现在在 MsgBoxEx 函数上遇到类型不匹配错误。 "AddressOf zWindowProc" 在此函数中突出显示。
任何人都可以帮助解决需要更改的内容吗?感谢您的帮助.........
Option Explicit
Public Enum ePosMsgBox
eTopLeft
eTopRight
eTopCentre
eBottomLeft
eBottomRight
eBottomCentre
eCentreScreen
eCentreDialog
End Enum
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal zlhHook As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe 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 PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Const GWL_HINSTANCE = (-6)
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private Const HCBT_ACTIVATE = 5
Private Const WH_CBT = 5
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long
Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private zlhHook As Long
Private zePosition As ePosMsgBox
Function MsgboxEx(Prompt As String, Optional Buttons As VbMsgBoxStyle, Optional Title, Optional HelpFile, Optional Context, Optional Position As ePosMsgBox) As VbMsgBoxResult
Dim lhInst As Long
Dim lThread As Long
lhInst = GetWindowLong(GetForegroundWindow, GWL_HINSTANCE)
lThread = GetCurrentThreadId()
zlhHook = SetWindowsHookEx(WH_CBT, AddressOf zWindowProc, lhInst, lThread)
zePosition = Position
MsgboxEx = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
End Function
Private Function zWindowProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tFormPos As RECT, tMsgBoxPos As RECT, tScreenWorkArea As RECT
Dim lLeft As Long, lTop As Long
Static sbRecursive As Boolean
If lMsg = HCBT_ACTIVATE Then
On Error Resume Next
tScreenWorkArea = ScreenWorkArea
GetWindowRect GetForegroundWindow, tFormPos
GetWindowRect wParam, tMsgBoxPos
Select Case zePosition
Case eCentreDialog
lLeft = (tFormPos.Left + (tFormPos.Right - tFormPos.Left) / 2) - ((tMsgBoxPos.Right - tMsgBoxPos.Left) / 2)
lTop = (tFormPos.Top + (tFormPos.Bottom - tFormPos.Top) / 2) - ((tMsgBoxPos.Bottom - tMsgBoxPos.Top) / 2)
Case eCentreScreen
lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2
lTop = ((tScreenWorkArea.Bottom - tScreenWorkArea.Top) - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)) / 2
Case eTopLeft
lLeft = tScreenWorkArea.Left
lTop = tScreenWorkArea.Top
Case eTopRight
lLeft = tScreenWorkArea.Right - (tMsgBoxPos.Right - tMsgBoxPos.Left)
lTop = tScreenWorkArea.Top
Case eTopCentre
lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2
lTop = tScreenWorkArea.Top
Case eBottomLeft
lLeft = tScreenWorkArea.Left
lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)
Case eBottomRight
lLeft = tScreenWorkArea.Right - (tMsgBoxPos.Right - tMsgBoxPos.Left)
lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)
Case eBottomCentre
lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left)) / 2
lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top)
End Select
If lLeft < 0 And sbRecursive = False Then
sbRecursive = True
zePosition = eCentreScreen
zWindowProc HCBT_ACTIVATE, wParam, lParam
sbRecursive = False
Exit Function
End If
SetWindowPos wParam, 0, lLeft, lTop, 10, 10, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
UnhookWindowsHookEx zlhHook
End If
zWindowProc = False
End Function
Function ScreenWorkArea() As RECT
Dim tScreen As RECT
Dim lRet As Long
Const SPI_GETWORKAREA = 48
lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, tScreen, 0)
ScreenWorkArea = tScreen
End Function
我能够解决我的问题。我在这个论坛的另一个问题中发现了这个 link,这对我帮助很大。我一行一行地为每个声明语句添加了 64 位版本,我还必须将几个变量更改为 64 位版本,它现在可以在 32 位或 64 位机器上运行。
http://www.cadsharp.com/docs/Win32API_PtrSafe.txt