Fatal编程技术网
  • vba/
  • VBA userform-解决挂接鼠标滚轮时的应用程序崩溃问题（VBA7、Win10/64位、Word2016/64位）

VBA userform-解决挂接鼠标滚轮时的应用程序崩溃问题（VBA7、Win10/64位、Word2016/64位）

vba ms-word

VBA userform-解决挂接鼠标滚轮时的应用程序崩溃问题（VBA7、Win10/64位、Word2016/64位）,vba,ms-word,Vba,Ms Word,通过数小时的搜索和谷歌搜索，我发现在32位Office中很好地记录了从VBA连接鼠标滚轮事件以用于用户表单/控件，并且我在Win10/64位和Word 2016/32位环境中快速、完美地实现了这一点。但是，当移动到64位办公环境（Win10/64位）时，它在调用“SetWindowsHookEx”然后移动鼠标光标后始终崩溃 注意到Long vs LongLong（LongPtr）实现从32位更改为64位，以及我发现的与Long/LongPtr相关的不一致的代码示例，我使用检查了代码的每一位，但它

通过数小时的搜索和谷歌搜索，我发现在32位Office中很好地记录了从VBA连接鼠标滚轮事件以用于用户表单/控件，并且我在Win10/64位和Word 2016/32位环境中快速、完美地实现了这一点。但是，当移动到64位办公环境（Win10/64位）时，它在调用“SetWindowsHookEx”然后移动鼠标光标后始终崩溃

注意到Long vs LongLong（LongPtr）实现从32位更改为64位，以及我发现的与Long/LongPtr相关的不一致的代码示例，我使用检查了代码的每一位，但它仍然崩溃

供参考：我正在构建自己的“插入交叉引用”功能，作为Word的附加模块，供私人使用

事件日志仅显示VBE7.dll中发生的“异常代码：0xc0000005”，我不知道如何继续对此进行故障排除。我花了几个小时在网上搜索选项，用我的代码尝试不同的东西，但都没有用。有人能建议如何深入研究这个问题吗？感谢您的帮助

下面是相关的代码片段，除了
WindowFromPoint
之外，所有声明都来自上面链接的WIN32API引用，因为
Point
的“LongLong”类型对我来说似乎是错误的。对
err.LastDllError
的所有检查均未报告任何错误，除了
SetWindowsHookEx
，来自
err.LastDllError
的消息已成功完成
命令。在
SetWindowsHookEx
上，消息为空，但返回非零鼠标挂钩。此调用后直接移动鼠标会使Word崩溃-删除对
SetWindowsHookEx
的调用不会使Word崩溃。我已经在
MouseProc
中设置了一个
debug.print
，但它从未到达那里

下面的代码是无效的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



选项显式
'GetWindowLong（）和GetWindowWord（）的窗口字段偏移量
私人建筑GWL_WNDPROC=（-4）
私有常量GWL\U HWNDPARENT=（-8）
私有常量GWL_样式=（-16）
私有常量GWL_EXSTYLE=（-20）
私有常量GWL_用户数据=（-21）
私有常量GWL_ID=（-12）
私人Const GWL_HINSTANCE As Long=（-6）
'设置用于鼠标滚轮的变量
专用常量，鼠标长度=14
专用常量WM_鼠标滚轮，如LongPtr=&H20A
私有常量HC_动作，只要=0
'DLL消息
Private Const FORMAT_MESSAGE_FROM_SYSTEM=&H1000
私有类型POINTAPI
X尽可能长
只要
端型
专用型味精
hwnd As LongPtr
信息尽可能长
wParam As LongPtr
lParam作为LongPtr
时间尽可能长
pt-As-POINTAPI
端型
专用型鼠标移动卡车
pt-As-POINTAPI
hwnd As LongPtr
wHitTestCode尽可能长
dwExtraInfo作为LongPtr
端型
私有声明PtrSafe函数GetCursorPos Lib“user32”（lpPoint作为POINTAPI）的长度为
'Private Declare PtrSafe Function WindowFromPoint Lib“user32”（ByVal point作为LongLong）作为LongPtr
私有声明PtrSafe函数WindowFromPoint Lib“user32”（ByVal point作为LongPtr）作为LongPtr
Private Declare PtrSafe Sub CopyMemory Lib“kernel32”别名“rtlmovemory”（目标为任意，源为任意，ByVal长度为LongPtr）
私有声明PtrSafe函数GetWindowLongPtr Lib“user32”别名“GetWindowLongPtrA”（ByVal hwnd为LongPtr，ByVal nIndex为Long）为LongPtr
私有声明PtrSafe函数SetWindowLongPtr Lib“user32”别名“SetWindowLongPtrA”（ByVal hwnd为LongPtr，ByVal nIndex为Long，ByVal dwNewLong为LongPtr）为LongPtr
私有声明PtrSafe函数SetWindowsHook Lib“user32”别名“SetWindowsHookA”（ByVal nFilterType为Long，ByVal pfnFilterProc为LongPtr）为LongPtr
私有声明PtrSafe函数setWindowshookx Lib“user32”别名“setWindowshookxa”（ByVal idHook作为LongPtr，ByVal lpfn作为LongPtr，ByVal hmod作为LongPtr，ByVal dwThreadId作为LongPtr）作为LongPtr
私有声明PtrSafe函数调用nexthookex Lib“user32”（ByVal hHook作为LongPtr，ByVal nCode作为LongPtr，ByVal wParam作为LongPtr，lParam作为任意）作为LongPtr
私有声明PtrSafe函数GetCurrentThreadId Lib“kernel32”（）的长度为
私有声明PtrSafe函数unhookwindowshookx Lib“user32”（ByVal hHook作为LongPtr）为Long
Private Declare PtrSafe函数FormatMessage Lib“kernel32”别名“FormatMessageA”（ByVal dwFlags为Long，lpSource为Any，ByVal dwMessageId为Long，ByVal dwLanguageId为Long，ByVal lpBuffer为String，ByVal nSize为Long，参数为LongPtr）为Long
私有声明PtrSafe函数GetLastError Lib“kernel32”（）的长度为
长
私有mCtl作为MSForms.Control
作为布尔值的私有mbHook
私人mLngMouseHook作为LongPtr
专用mListBoxHwnd作为长PTR
子钩子ListBoxScroll64（frm作为对象，ctl作为MSForms.Control）
Dim tPT作为POINTAPI
昏暗的长袍
将HwnUnderCursor变暗为LongPtr
像长一样暗
GetCursorPos tPT
Debug.Print“GetCursorPos err:”&GetWin32ErrorDescription（err.LastDllError）
ptLL=点到隆隆（tPT）
Debug.Print“PointToLongLong err:&GetWin32ErrorDescription（err.LastDllError）
HwnUnderCursor=WindowFromPoint（ptLL）
Debug.Print“WindowFromPoint err:&GetWin32ErrorDescription（err.LastDllError）
如果Not IsNull（frm.ActiveControl）且Not frm.ActiveControl为ctl，则
ctl.SetFocus
如果结束
如果是mListBoxHwnd HwnUnderCursor，则
UnhookListBoxScroll64
Debug.Print“UnhookListBoxScroll64 err:&GetWin32ErrorDescription（err.LastDllError）
设置mCtl=ctl
mListBoxHwnd=hwndUnderCursor
lngAppInst=GetWindowLongPtr（mListBoxHwnd，GWL_HINSTANCE）
Debug.Print“GetWindowLongPtr AppInst:”&lngAppInst&“，err:”&GetWin32ErrorDescription（err.LastDllError）
如果不是，那么
mLngMouseHook=