[Hỏi] Sự kiện Keyboard Hook trên Cells

Liên hệ QC

Mutants Men

Thành viên thường trực
Tham gia
30/12/15
Bài viết
394
Được thích
266
Chào mọi người
Em có tìm được một code tại diễn đàn này dùng để bắt sự kiện khi thao tác trên bàn phím
nhưng khi chạy code thì phải chọn sang cửa sổ làm việc khác (không phải excel) thì mới chạy được.
em có thêm âm thanh khi chạy code thì thấy khi nhấn 1 phím thì phát ra tiếng Beep 2 lần. vậy là code đó sẽ chạy 2 lần khi nhấn phím hay sao (vậy nếu muốn chạy 1 lần thì làm sao)
vậy mình có thể sửa như thế nào để có thể chạy được trong excel khi đang thao tác ngay TRONG 1 ô của bảng tính được?
Mã:
Option Explicit
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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WH_KEYBOARD_LL = 13
Private Const HC_ACTION = 0
Private Const HC_NOREMOVE = 3
Public Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
Private hHook As Long
Public IsHooked As Boolean
Public Sub SetKeyboardHook()
    If IsHooked Then
        MsgBox "Don't hook WH_KEYBOARD_LL twice or you will be unable to unhook it."
    Else
        hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, Application.Hinstance, 0)
        IsHooked = True
    End If
End Sub
Public Sub RemoveKeyboardHook()
    UnhookWindowsHookEx hHook
    IsHooked = False
End Sub
Public Function LowLevelKeyboardProc(ByVal uCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long
    If uCode >= 0 Then
        Select Case uCode
        Case HC_ACTION
            'Debug.Print Hex(lParam.vkCode)
            'If a RETURN key is pulled from the queue then discard it.
            If lParam.vkCode = &HD Then
                LowLevelKeyboardProc = 1
                Exit Function
            End If
        Case HC_NOREMOVE
            'The message has not been removed from the message queue
        End Select
    End If
    LowLevelKeyboardProc = CallNextHookEx(hHook, uCode, wParam, lParam)
    Beep
End Function
Private Sub Command1()
    SetKeyboardHook
End Sub
Private Sub Form_Unload()
    RemoveKeyboardHook
End Sub
trình độ em chỉ là lính mới nên mong được mọi người chỉ dẫn
 
Web KT
Back
Top Bottom