Добрый день, уважаемые форумчане. Помогите разобраться с проблемой.
У меня есть код, выполненный в формате vbp (то есть Microsoft Visual Basic). И в этой программе - он прекрасно работает. Но вот когда я его переношу в эксель Е2013 - работать он отказывается, и ругается "Variable not defined".
Как заставить этот код - работать в экселе ?
(Прикрепляю файл vbp, скомпилированный экзешник и файл экселя - куда я пытался впихнуть этот код)
Код выглядит так: [vba]
Код
Option Explicit
Private Type POINTAPI x As Long y As Long End Type Private Type MSLLHOOKSTRUCT pt As POINTAPI mouseData As Long flags As Long time As Long dwExtraInfo As Long End Type Private Type KBDLLHOOKSTRUCT VkCode As Long ScanCode As Long flags As Long time As Long dwExtraInfo As Long End Type
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Integer, lParam As Any) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Const WH_KEYBOARD_LL = 13 Private Const WH_MOUSE_LL = &HE& Private Const HC_ACTION = 0 Private Const LLKHF_INJECTED = &H10 Private Const LLMHF_INJECTED = 1 Private Const WM_KEYDOWN As Long = &H100 Private Const WM_KEYUP As Long = &H101 Private Const WM_SYSKEYDOWN As Long = &H104 Private Const WM_SYSKEYUP As Long = &H105 Private Const WM_MOUSEMOVE As Long = &H200 Private Const WM_LBUTTONDOWN As Long = &H201 Private Const WM_LBUTTONUP As Long = &H202 Private Const WM_MBUTTONDOWN As Long = &H207 Private Const WM_MBUTTONUP As Long = &H208 Private Const WM_RBUTTONDOWN As Long = &H204 Private Const WM_RBUTTONUP As Long = &H205 Private Const WM_MOUSEWHEEL As Long = &H20A
Dim hKeyHook As Long, hMouseHook As Long
Public Sub Hook() hKeyHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelkbdProc, App.Hinstance, 0) If hKeyHook = 0 Then MsgBox ("Keyboard hook error") hMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, App.Hinstance, 0) If hMouseHook = 0 Then MsgBox ("Mouse hook error") End Sub Public Sub UnHook() If hKeyHook Then UnhookWindowsHookEx (hKeyHook): hKeyHook = 0 If hMouseHook Then UnhookWindowsHookEx (hMouseHook): hMouseHook = 0 End Sub
Private Function LowLevelkbdProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long If uCode = HC_ACTION Then Select Case wParam Case WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP frmMain.lstEvenst.AddItem KeyString(wParam) & _ "KeyCode: " & lParam.VkCode & _ " ScanCode: " & lParam.ScanCode & _ IIf(lParam.flags And LLKHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 End Select End If LowLevelkbdProc = CallNextHookEx(hKeyHook, uCode, wParam, lParam) End Function
Private Function LowLevelMouseProc(ByVal uCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long If uCode = HC_ACTION Then Select Case wParam Case WM_MOUSEMOVE frmMain.lstEvenst.AddItem "MouseMove: " & _ "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 Case WM_MOUSEWHEEL frmMain.lstEvenst.AddItem "MouseWheel: " & _ "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ " Dir: " & IIf(lParam.mouseData > 0, "Forward", "Backward") & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 Case Else frmMain.lstEvenst.AddItem MouseString(wParam) & _ " Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 End Select End If LowLevelMouseProc = CallNextHookEx(hMouseHook, uCode, wParam, lParam) End Function Private Function MouseString(WH As Long) As String Select Case WH Case WM_LBUTTONDOWN: MouseString = "MouseLButtonDown:" Case WM_LBUTTONUP: MouseString = "MouseLButtonUp:" Case WM_RBUTTONDOWN: MouseString = "MouseRButtonDown:" Case WM_RBUTTONUP: MouseString = "MouseRButtonUp:" Case WM_MBUTTONDOWN: MouseString = "MouseMButtonDown:" Case WM_MBUTTONUP: MouseString = "MouseMMuttonUp:" End Select End Function Private Function KeyString(WH As Long) As String Select Case WH Case WM_KEYDOWN: KeyString = "KeyDown:" Case WM_KEYUP: KeyString = "KeyUp:" Case WM_SYSKEYDOWN: KeyString = "KeySysDown:" Case WM_SYSKEYUP: KeyString = "KeySysUp:" End Select End Function
[/vba]
Код формы: [vba]
Код
Option Explicit
Private Sub cmdRemoveHook_Click() UnHook End Sub Private Sub cmdSetHook_Click() Hook End Sub Private Sub Form_Unload(Cancel As Integer) UnHook End Sub
[/vba]
Добрый день, уважаемые форумчане. Помогите разобраться с проблемой.
У меня есть код, выполненный в формате vbp (то есть Microsoft Visual Basic). И в этой программе - он прекрасно работает. Но вот когда я его переношу в эксель Е2013 - работать он отказывается, и ругается "Variable not defined".
Как заставить этот код - работать в экселе ?
(Прикрепляю файл vbp, скомпилированный экзешник и файл экселя - куда я пытался впихнуть этот код)
Код выглядит так: [vba]
Код
Option Explicit
Private Type POINTAPI x As Long y As Long End Type Private Type MSLLHOOKSTRUCT pt As POINTAPI mouseData As Long flags As Long time As Long dwExtraInfo As Long End Type Private Type KBDLLHOOKSTRUCT VkCode As Long ScanCode As Long flags As Long time As Long dwExtraInfo As Long End Type
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Integer, lParam As Any) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Const WH_KEYBOARD_LL = 13 Private Const WH_MOUSE_LL = &HE& Private Const HC_ACTION = 0 Private Const LLKHF_INJECTED = &H10 Private Const LLMHF_INJECTED = 1 Private Const WM_KEYDOWN As Long = &H100 Private Const WM_KEYUP As Long = &H101 Private Const WM_SYSKEYDOWN As Long = &H104 Private Const WM_SYSKEYUP As Long = &H105 Private Const WM_MOUSEMOVE As Long = &H200 Private Const WM_LBUTTONDOWN As Long = &H201 Private Const WM_LBUTTONUP As Long = &H202 Private Const WM_MBUTTONDOWN As Long = &H207 Private Const WM_MBUTTONUP As Long = &H208 Private Const WM_RBUTTONDOWN As Long = &H204 Private Const WM_RBUTTONUP As Long = &H205 Private Const WM_MOUSEWHEEL As Long = &H20A
Dim hKeyHook As Long, hMouseHook As Long
Public Sub Hook() hKeyHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelkbdProc, App.Hinstance, 0) If hKeyHook = 0 Then MsgBox ("Keyboard hook error") hMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, App.Hinstance, 0) If hMouseHook = 0 Then MsgBox ("Mouse hook error") End Sub Public Sub UnHook() If hKeyHook Then UnhookWindowsHookEx (hKeyHook): hKeyHook = 0 If hMouseHook Then UnhookWindowsHookEx (hMouseHook): hMouseHook = 0 End Sub
Private Function LowLevelkbdProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long If uCode = HC_ACTION Then Select Case wParam Case WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP frmMain.lstEvenst.AddItem KeyString(wParam) & _ "KeyCode: " & lParam.VkCode & _ " ScanCode: " & lParam.ScanCode & _ IIf(lParam.flags And LLKHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 End Select End If LowLevelkbdProc = CallNextHookEx(hKeyHook, uCode, wParam, lParam) End Function
Private Function LowLevelMouseProc(ByVal uCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long If uCode = HC_ACTION Then Select Case wParam Case WM_MOUSEMOVE frmMain.lstEvenst.AddItem "MouseMove: " & _ "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 Case WM_MOUSEWHEEL frmMain.lstEvenst.AddItem "MouseWheel: " & _ "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ " Dir: " & IIf(lParam.mouseData > 0, "Forward", "Backward") & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 Case Else frmMain.lstEvenst.AddItem MouseString(wParam) & _ " Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 End Select End If LowLevelMouseProc = CallNextHookEx(hMouseHook, uCode, wParam, lParam) End Function Private Function MouseString(WH As Long) As String Select Case WH Case WM_LBUTTONDOWN: MouseString = "MouseLButtonDown:" Case WM_LBUTTONUP: MouseString = "MouseLButtonUp:" Case WM_RBUTTONDOWN: MouseString = "MouseRButtonDown:" Case WM_RBUTTONUP: MouseString = "MouseRButtonUp:" Case WM_MBUTTONDOWN: MouseString = "MouseMButtonDown:" Case WM_MBUTTONUP: MouseString = "MouseMMuttonUp:" End Select End Function Private Function KeyString(WH As Long) As String Select Case WH Case WM_KEYDOWN: KeyString = "KeyDown:" Case WM_KEYUP: KeyString = "KeyUp:" Case WM_SYSKEYDOWN: KeyString = "KeySysDown:" Case WM_SYSKEYUP: KeyString = "KeySysUp:" End Select End Function
[/vba]
Код формы: [vba]
Код
Option Explicit
Private Sub cmdRemoveHook_Click() UnHook End Sub Private Sub cmdSetHook_Click() Hook End Sub Private Sub Form_Unload(Cancel As Integer) UnHook End Sub
И не мудрено, что Excel ругается. Ведь, несмотря на то, что у вас указано Option Explicit, переменная (наверное, объект) App не определёна и тем более Excel ничего не знает о её свойстве (методе) App.Hinstance Вообще, не понятно, что должна делать процедура? А без комментариев и пояснений разбираться в чужом коде - Опишите, чего Вы хотите добиться? Может быть для этого вовсе не надо применять WinAPI?
И не мудрено, что Excel ругается. Ведь, несмотря на то, что у вас указано Option Explicit, переменная (наверное, объект) App не определёна и тем более Excel ничего не знает о её свойстве (методе) App.Hinstance Вообще, не понятно, что должна делать процедура? А без комментариев и пояснений разбираться в чужом коде - Опишите, чего Вы хотите добиться? Может быть для этого вовсе не надо применять WinAPI?Alex_ST
Alex_ST, в коде происходит перехват событий ввода клавиатуры и движений мышки. Причем как при активной, так и при неактивной книге эксель - чего я и хотел добиться. Это происходит с помощью клавиатурного хука SetWindowsHookEx, причем без всяких глюков и тормозов.
У меня там в архиве - лежит экзешник, который я скомпилировал из программы Microsoft Visual Basic. Его достаточно запустить и нажать кнопку "Set hook"
Код этот не мой. Комментариев к нему было всего два.
[vba]
Код
' Процедура перехвата сообщений клавиатуры Private Function LowLevelkbdProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long If uCode = HC_ACTION Then Select Case wParam Case WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP frmMain.lstEvenst.AddItem KeyString(wParam) & _ "KeyCode: " & lParam.VkCode & _ " ScanCode: " & lParam.ScanCode & _ IIf(lParam.flags And LLKHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 End Select End If LowLevelkbdProc = CallNextHookEx(hKeyHook, uCode, wParam, lParam) End Function ' Процедура перехвата сообщений мыши Private Function LowLevelMouseProc(ByVal uCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long If uCode = HC_ACTION Then Select Case wParam Case WM_MOUSEMOVE frmMain.lstEvenst.AddItem "MouseMove: " & _ "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 Case WM_MOUSEWHEEL frmMain.lstEvenst.AddItem "MouseWheel: " & _ "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ " Dir: " & IIf(lParam.mouseData > 0, "Forward", "Backward") & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 Case Else frmMain.lstEvenst.AddItem MouseString(wParam) & _ " Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 End Select End If LowLevelMouseProc = CallNextHookEx(hMouseHook, uCode, wParam, lParam) End Function
[/vba]
Alex_ST, в коде происходит перехват событий ввода клавиатуры и движений мышки. Причем как при активной, так и при неактивной книге эксель - чего я и хотел добиться. Это происходит с помощью клавиатурного хука SetWindowsHookEx, причем без всяких глюков и тормозов.
У меня там в архиве - лежит экзешник, который я скомпилировал из программы Microsoft Visual Basic. Его достаточно запустить и нажать кнопку "Set hook"
Код этот не мой. Комментариев к нему было всего два.
[vba]
Код
' Процедура перехвата сообщений клавиатуры Private Function LowLevelkbdProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long If uCode = HC_ACTION Then Select Case wParam Case WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP frmMain.lstEvenst.AddItem KeyString(wParam) & _ "KeyCode: " & lParam.VkCode & _ " ScanCode: " & lParam.ScanCode & _ IIf(lParam.flags And LLKHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 End Select End If LowLevelkbdProc = CallNextHookEx(hKeyHook, uCode, wParam, lParam) End Function ' Процедура перехвата сообщений мыши Private Function LowLevelMouseProc(ByVal uCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long If uCode = HC_ACTION Then Select Case wParam Case WM_MOUSEMOVE frmMain.lstEvenst.AddItem "MouseMove: " & _ "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 Case WM_MOUSEWHEEL frmMain.lstEvenst.AddItem "MouseWheel: " & _ "Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ " Dir: " & IIf(lParam.mouseData > 0, "Forward", "Backward") & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 Case Else frmMain.lstEvenst.AddItem MouseString(wParam) & _ " Coord: " & lParam.pt.x & ", " & lParam.pt.y & _ IIf(lParam.flags And LLMHF_INJECTED, "(inj)", vbNullString) frmMain.lstEvenst.ListIndex = frmMain.lstEvenst.ListCount - 1 End Select End If LowLevelMouseProc = CallNextHookEx(hMouseHook, uCode, wParam, lParam) End Function
Что-то я сомневаюсь, что события клавы и мыши вообще могут отрабатываться НЕ АКТИВНОЙ книгой Excel... Тут моей компетенции в VBA явно недостаточно, нужно на уровень взаимодействия приложения с виндой выходить
Что-то я сомневаюсь, что события клавы и мыши вообще могут отрабатываться НЕ АКТИВНОЙ книгой Excel... Тут моей компетенции в VBA явно недостаточно, нужно на уровень взаимодействия приложения с виндой выходить Alex_ST