Помогите разобраться, есть два компьютера оба 64-bit , на одном компьютере работает без проблем , на другом выдает ошибку
ошибка тут
| Код |
|---|
'''''' normal module code #If VBA7 Then Option Explicit Private Type POINTAPI X As Long Y As Long End Type Private Type MOUSEHOOKSTRUCT pt As POINTAPI hwnd As Long wHitTestCode As Long dwExtraInfo As Long End Type Private Declare PtrSafe Function FindWindow Lib "user32" _ Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _ Alias "GetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As Long) As LongPtr 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 LongPtr Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _ ByVal hHook As Long, _ ByVal nCode As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _ ByVal hHook As Long) As LongPtr 'Private Declare PtrSafe Function PostMessage Lib "user32.dll" _ ' Alias "PostMessageA" ( _ ' ByVal hwnd As Long, _ ' ByVal wMsg As Long, _ ' ByVal wParam As Long, _ ' ByVal lParam As Long) As LongPtr Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _ ByVal xPoint As Long, _ ByVal yPoint As Long) As LongPtr Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _ ByRef lpPoint As POINTAPI) As LongPtr Private Const WH_MOUSE_LL As Long = 14 Private Const WM_MOUSEWHEEL As Long = &H20A Private Const HC_ACTION As Long = 0 Private Const GWL_HINSTANCE As Long = (-6) 'Private Const WM_KEYDOWN As Long = &H100 'Private Const WM_KEYUP As Long = &H101 'Private Const VK_UP As Long = &H26 'Private Const VK_DOWN As Long = &H28 'Private Const WM_LBUTTONDOWN As Long = &H201 Private mLngMouseHook As Long Private mComboBoxHwnd As Long Private mbHook As Boolean Private mCtl As MSForms.Control Dim n As Long Sub HookComboBoxScroll(frm As Object, ctl As MSForms.Control) Dim lngAppInst As Long Dim hwndUnderCursor As Long Dim tPT As POINTAPI GetCursorPos tPT hwndUnderCursor WindowFromPoint(tPT.X, tPT.Y) If Not frm.ActiveControl Is ctl Then ctl.SetFocus End If If mComboBoxHwnd <> hwndUnderCursor Then UnhookComboBoxScroll Set mCtl = ctl mComboBoxHwnd = hwndUnderCursor lngAppInst = GetWindowLong(mComboBoxHwnd, GWL_HINSTANCE) ' PostMessage mComboBoxHwnd, WM_LBUTTONDOWN, 0&, 0& If Not mbHook Then mLngMouseHook = SetWindowsHookEx( _ WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0) mbHook = mLngMouseHook <> 0 End If End Sub Sub UnhookComboBoxScroll() If mbHook Then Set mCtl = Nothing UnhookWindowsHookEx mLngMouseHook mLngMouseHook = 0 mComboBoxHwnd = 0 mbHook = False End If End Sub Private Function MouseProc( _ ByVal nCode As Long, ByVal wParam As Long, _ ByRef lParam As MOUSEHOOKSTRUCT) As Long Dim idx As Long On Error GoTo errH If (nCode = HC_ACTION) Then If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mComboBoxHwnd Then If wParam = WM_MOUSEWHEEL Then MouseProc = True ' If lParam.hwnd > 0 Then ' PostMessage mComboBoxHwnd, WM_KEYDOWN, VK_UP, 0 ' Else ' PostMessage mComboBoxHwnd, WM_KEYDOWN, VK_DOWN, 0 ' End If ' PostMessage mComboBoxHwnd, WM_KEYUP, VK_UP, 0 If lParam.hwnd > 0 Then idx = -1 Else idx = 1 ' idx = idx + mCtl.ListIndex ' If idx >= 0 Then mCtl.ListIndex = idx idx = idx + mCtl.TopIndex If idx >= 0 Then mCtl.TopIndex = idx Exit Function End If Else UnhookComboBoxScroll End If End If End As Variant MouseProc = CallNextHookEx( _ mLngMouseHook, nCode, wParam, ByVal lParam) Exit Function errH: UnhookComboBoxScroll End Function '''''''' end normal module code End As Variant #End If |
ошибка тут
| Код |
|---|
Sub HookComboBoxScroll(frm As Object, ctl As MSForms.Control) WindowFromPoint |
Изменено: - 02.12.2017 20:00:36