经过数小时的搜索和查找，我发现在32位Office上很好地记录了从VBA挂接到用户窗体/控件中的鼠标滚轮事件，并且我使它可以在Win10 / 64位和Word 2016/32位环境。但是，当移动到64位Office环境（Win10 / 64bit）时，在调用“ SetWindowsHookEx”然后移动鼠标光标后，它始终崩溃。
[意识到Long vs LongLong（LongPtr）的实现从32位变为64位，并且发现与Long / LongPtr有关的代码示例不一致，我使用the standard Microsoft WIN32API declare statements for 64 bit检查了我的代码的每一位，但仍然崩溃。
供参考：我正在构建自己的“插入交叉引用”功能，作为Word的附加组件，供私人使用。
事件日志仅显示VBE7.dll中发生的'异常代码：0xc0000005'，我不知所措，因为如何继续对此进行故障排除。我花了数小时在网上搜索选项，尝试用我的代码进行其他操作，但无济于事。谁能建议如何继续深入研究此问题？任何帮助表示赞赏。
相关代码段如下，所有声明均来自上述链接的WIN32API参考，但WindowFromPoint除外，因为Point的'LongLong'类型在我看来是错误的。对err.LastDllError的所有检查均未报告错误，除了SetWindowsHookEx之外，err.lastDllError的消息为Command successfully completed。在SetWindowsHookEx上，该消息为空，但返回了非零的鼠标挂钩。在此调用后直接移动鼠标会使Word崩溃-将呼叫移至SetWindowsHookEx不会使Word崩溃。我在debug.print中设置了MouseProc，但它从未到达那里。
下面的代码没有进行VBA7 / WIN64检查，因为我希望使用干净的代码进行64位检查并使其正常工作，然后再将其与32位实现合并。
Option Explicit
' Window field offsets for GetWindowLong() and GetWindowWord()
Private Const GWL_WNDPROC = (-4)
Private Const GWL_HWNDPARENT = (-8)
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const GWL_USERDATA = (-21)
Private Const GWL_ID = (-12)
Private Const GWL_HINSTANCE As Long = (-6)
'set up the variables used for the mousewheel
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As LongPtr = &H20A
Private Const HC_ACTION As Long = 0
' DLL messages
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type Msg
hwnd As LongPtr
message As Long
wParam As LongPtr
lParam As LongPtr
time As Long
pt As POINTAPI
End Type
Private Type MOUSEHOOKSTRUCT
pt As POINTAPI
hwnd As LongPtr
wHitTestCode As Long
dwExtraInfo As LongPtr
End Type
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal point As LongLong) As LongPtr
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal point As LongPtr) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowsHook Lib "user32" Alias "SetWindowsHookA" (ByVal nFilterType As Long, ByVal pfnFilterProc As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As LongPtr) As Long
Private Declare PtrSafe Function GetLastError Lib "kernel32" () As Long
Dim n As Long
Private mCtl As MSForms.Control
Private mbHook As Boolean
Private mLngMouseHook As LongPtr
Private mListBoxHwnd As LongPtr
Sub HookListBoxScroll64(frm As Object, ctl As MSForms.Control)
Dim tPT As POINTAPI
Dim lngAppInst As LongPtr
Dim hwndUnderCursor As LongPtr
Dim ptLL As LongLong
GetCursorPos tPT
Debug.Print "GetCursorPos err: " & GetWin32ErrorDescription(err.LastDllError)
ptLL = PointToLongLong(tPT)
Debug.Print "PointToLongLong err: " & GetWin32ErrorDescription(err.LastDllError)
hwndUnderCursor = WindowFromPoint(ptLL)
Debug.Print "WindowFromPoint err: " & GetWin32ErrorDescription(err.LastDllError)
If Not IsNull(frm.ActiveControl) And Not frm.ActiveControl Is ctl Then
ctl.SetFocus
End If
If mListBoxHwnd <> hwndUnderCursor Then
UnhookListBoxScroll64
Debug.Print "UnhookListBoxScroll64 err: " & GetWin32ErrorDescription(err.LastDllError)
Set mCtl = ctl
mListBoxHwnd = hwndUnderCursor
lngAppInst = GetWindowLongPtr(mListBoxHwnd, GWL_HINSTANCE)
Debug.Print "GetWindowLongPtr AppInst: " & lngAppInst & ", err: " & GetWin32ErrorDescription(err.LastDllError)
If Not mbHook Then
mLngMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
Debug.Print "SetWindowsHookEx hook: " & mLngMouseHook & ", err: " & GetWin32ErrorDescription(err.LastDllError)
mbHook = mLngMouseHook <> 0
End If
End If
End Sub
Private Function MouseProc( _
ByVal nCode As Long, ByVal wParam As LongPtr, _
ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
Debug.Print "MouseProc"
Dim idx As Long
On Error GoTo errH
If (nCode = HC_ACTION) Then
Dim ptLL As LongLong
ptLL = PointToLongLong(lParam.pt)
If WindowFromPoint(ptLL) = mListBoxHwnd Then
If wParam = WM_MOUSEWHEEL Then
MouseProc = True
If TypeOf mCtl Is frame Then
If lParam.hwnd > 0 Then idx = -10 Else idx = 10
idx = idx + mCtl.ScrollTop
If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
mCtl.ScrollTop = idx
End If
ElseIf TypeOf mCtl Is UserForm Then
If lParam.hwnd > 0 Then idx = -10 Else idx = 10
idx = idx + mCtl.ScrollTop
If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
mCtl.ScrollTop = idx
End If
Else
If lParam.hwnd > 0 Then idx = -1 Else idx = 1
idx = idx + mCtl.ListIndex
If idx >= 0 Then mCtl.ListIndex = idx
End If
Exit Function
End If
Else
UnhookListBoxScroll64
End If
End If
MouseProc = CallNextHookEx( _
mLngMouseHook, nCode, wParam, ByVal lParam)
Exit Function
errH:
UnhookListBoxScroll64
End Function
经过数小时的搜索，并谷歌搜索我发现，对于32位Office，已经很好地记录了从VBA插入鼠标滚轮事件以用于用户窗体/控件的情况，我知道这可以正常工作...