Bắt sự kiện KeyPressed trên Cell

Liên hệ QC

rollover79

Thành viên tiêu biểu
Tham gia
10/9/08
Bài viết
764
Được thích
1,310
Tôi xin gửi mọi người cùng tham khảo 1 phương pháp để bắt sự kiện KeyPressed trên 1 cell ngay cả khi đang edit, để từ đó có thể xử lý trực tiếp từng ký tự được nhập vào.
Trong file ví dụ tôi xử lý sự kiện cho ô A1(Xác định trong Worksheet_SelectionChange của Sheet1), và chỉ cho phép nhập các ký tự là số(từ 0 đến 9, sự kiện được xử lý tại hàm Cell_OnKeyDown của module)
 

File đính kèm

  • KeyPressedEventOnCell.rar
    11.2 KB · Đọc: 487
Tôi xin gửi mọi người cùng tham khảo 1 phương pháp để bắt sự kiện KeyPressed trên 1 cell ngay cả khi đang edit, để từ đó có thể xử lý trực tiếp từng ký tự được nhập vào.
Trong file ví dụ tôi xử lý sự kiện cho ô A1(Xác định trong Worksheet_SelectionChange của Sheet1), và chỉ cho phép nhập các ký tự là số(từ 0 đến 9, sự kiện được xử lý tại hàm Cell_OnKeyDown của module)

Trong khi ta soạn thảo, nhấn phím Tab, Shift + Tab để chuyển con trỏ. Các bác nên bổ sung thêm kiểm tra phím Tab trong đoạn code của bác rollover79 như sau:

Mã:
                Select Case keyCode
                    Case vbKey0 To vbKey9, vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyF2, _
                        vbKeyReturn, vbKeyEscape, vbKeyBack, vbKeyDelete, vbKeyHome, vbKeyEnd, _
                        [COLOR="Blue"]vbKeyTab[/COLOR]
                        Cell_OnKeyDown = 0
                    Case vbKeyShift
                        Debug.Print "vbKeyShift"
                    Case Else
                        Cell_OnKeyDown = -1
                        Exit Function
                End Select

Từ ứng dụng này, nếu mở rộng chúng ta có thể kiểm tra việc nhập ngày tháng, số tiền, lớn hơn nữa có thể làm dạng "InputMask".
 
Upvote 0
Trong khi ta soạn thảo, nhấn phím Tab, Shift + Tab để chuyển con trỏ. Các bác nên bổ sung thêm kiểm tra phím Tab trong đoạn code của bác rollover79 như sau:

Mã:
                Select Case keyCode
                    Case vbKey0 To vbKey9, vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyF2, _
                        vbKeyReturn, vbKeyEscape, vbKeyBack, vbKeyDelete, vbKeyHome, vbKeyEnd, _
                        [COLOR="Blue"]vbKeyTab[/COLOR]
                        Cell_OnKeyDown = 0
                    Case vbKeyShift
                        Debug.Print "vbKeyShift"
                    Case Else
                        Cell_OnKeyDown = -1
                        Exit Function
                End Select

Từ ứng dụng này, nếu mở rộng chúng ta có thể kiểm tra việc nhập ngày tháng, số tiền, lớn hơn nữa có thể làm dạng "InputMask".
Xin bổ xung thêm trong ví dụ đã gửi, mọi người thêm lệnh gọi Unhook_KeyBoard trước các câu lệnh xử lý trong sự kiện SelectionChange để hủy việc bắt sự kiện khi chuyển sang vùng khác. Việc gọi lại Unhook_KeyBoard trong trường hợp này rất quan trọng, vì nó sẽ trả lại trạng thái bình thường cho các sự kiện của bàn phím.
 
Upvote 0
Xin bổ xung thêm trong ví dụ đã gửi, mọi người thêm lệnh gọi Unhook_KeyBoard trước các câu lệnh xử lý trong sự kiện SelectionChange để hủy việc bắt sự kiện khi chuyển sang vùng khác. Việc gọi lại Unhook_KeyBoard trong trường hợp này rất quan trọng, vì nó sẽ trả lại trạng thái bình thường cho các sự kiện của bàn phím.

Liên quan tới việc Hook hệ thống bàn phím là rất quan trọng, sơ xảy một cái là đơ ứng dụng ngay. Nếu cần phải lưu giá trị kiểu long vào Registry, khi cần dùng thì lấy lại.

Mã:
Public Sub Unhook_KeyBoard()
    If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd
End Sub

Sub ActiveEvent(rng As Range)
    hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf Cell_OnKeyDown, Application.Hinstance, 0)
End Sub

Trong VBA, khi gặp lỗi cá biến như hhkLowLevelKybd sẽ = 0 (bị giải phóng) khi đó thủ tục Unhook_KeyBoard không có ý nghĩa gì. Mà nếu Unhook_KeyBoard không làm đúng như mong đợi thì ứng dụng bị lỗi.
 
Upvote 0
Liên quan tới việc Hook hệ thống bàn phím là rất quan trọng, sơ xảy một cái là đơ ứng dụng ngay. Nếu cần phải lưu giá trị kiểu long vào Registry, khi cần dùng thì lấy lại.

Mã:
Public Sub Unhook_KeyBoard()
    If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd
End Sub

Sub ActiveEvent(rng As Range)
    hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf Cell_OnKeyDown, Application.Hinstance, 0)
End Sub

Trong VBA, khi gặp lỗi cá biến như hhkLowLevelKybd sẽ = 0 (bị giải phóng) khi đó thủ tục Unhook_KeyBoard không có ý nghĩa gì. Mà nếu Unhook_KeyBoard không làm đúng như mong đợi thì ứng dụng bị lỗi.
Vậy thì theo em giải pháp là gì?

Lê Văn Duyệt
 
Upvote 0
Vậy thì theo em giải pháp là gì?

Lê Văn Duyệt

Theo em thì nên làm thế này:

Mã:
Sub ActiveEvent(rng As Range)
    hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf Cell_OnKeyDown, Application.Hinstance, 0)
    SaveHookIDToReg hhkLowLevelKybd
End Sub

Public Sub Unhook_KeyBoard()
     if hhkLowLevelKybd = 0 Then
             hhkLowLevelKybd = GetHookIDfromReg()
     End If
    If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd
End Sub

Sub SaveHookIDToReg(ByVal nHookID As Long)
    SaveSetting "MyXlApp", "KEYBOARD", "HookID", nHookID
End Sub
Function GetHookIDfromReg() As Long
    GetHookIDfromReg = CLng(GetSetting("MyXlApp", "KEYBOARD", "HookID", 0))
End Function
 
Upvote 0
Theo em thì nên làm thế này:

Mã:
Sub ActiveEvent(rng As Range)
    hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf Cell_OnKeyDown, Application.Hinstance, 0)
    SaveHookIDToReg hhkLowLevelKybd
End Sub

Public Sub Unhook_KeyBoard()
     if hhkLowLevelKybd = 0 Then
             hhkLowLevelKybd = GetHookIDfromReg()
     End If
    If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd
End Sub

Sub SaveHookIDToReg(ByVal nHookID As Long)
    SaveSetting "MyXlApp", "KEYBOARD", "HookID", nHookID
End Sub
Function GetHookIDfromReg() As Long
    GetHookIDfromReg = CLng(GetSetting("MyXlApp", "KEYBOARD", "HookID", 0))
End Function
Theo tôi thì trong 1 ứng dụng, việc lưu giá trị vào 1 biến module thì chưa gặp trường hợp nào bị mất giá trị cả. Việc kiểm soát lỗi đương nhiên là rất quan trọng, trong trường hợp này càng quan trọng hơn. Ở đây lỗi sẽ xảy ra khi ta đã hook mà không unhook, hoặc có thể là do hook khi chưa giải phóng unhook, còn việc unhook khi chưa gọi hook thì không vấn đề gì, có thể dùng On Error Resume Next là chắc ăn. Còn trong trường hợp còn lại, nếu khi đã gọi hook mà không xảy ra lỗi thì tất nhiên sẽ trả về ID, việc đã lưu ID vào 1 biến module rồi thì tôi nghĩ không cần thiết phải ghi vào Registry, mức độ là như nhau. Có chăng thì ta cần thêm 1 biến IsHookEnabled kiểu boolean, sau khi unhook thì gán IsHookEnabled = false, trước khi gọi hook kiểm tra IsHookEnabled=false thì mới thực hiện, nếu bằng true thì không thực hiện hoặc gọi unhook trước, sau khi hook thì gán IsHookEnabled = true.
 
Upvote 0
Theo tôi thì trong 1 ứng dụng, việc lưu giá trị vào 1 biến module thì chưa gặp trường hợp nào bị mất giá trị cả. Việc kiểm soát lỗi đương nhiên là rất quan trọng, trong trường hợp này càng quan trọng hơn. Ở đây lỗi sẽ xảy ra khi ta đã hook mà không unhook, hoặc có thể là do hook khi chưa giải phóng unhook, còn việc unhook khi chưa gọi hook thì không vấn đề gì, có thể dùng On Error Resume Next là chắc ăn. Còn trong trường hợp còn lại, nếu khi đã gọi hook mà không xảy ra lỗi thì tất nhiên sẽ trả về ID, việc đã lưu ID vào 1 biến module rồi thì tôi nghĩ không cần thiết phải ghi vào Registry, mức độ là như nhau. Có chăng thì ta cần thêm 1 biến IsHookEnabled kiểu boolean, sau khi unhook thì gán IsHookEnabled = false, trước khi gọi hook kiểm tra IsHookEnabled=false thì mới thực hiện, nếu bằng true thì không thực hiện hoặc gọi unhook trước, sau khi hook thì gán IsHookEnabled = true.

Vậy bạn phải bẫy lỗi rất cặn kẽ, nếu không thì sẽ như tôi nói đó. Vì tỗi đã bị vậy khi chạy ví dụ của bạn mà. Cái tôi nói cũng là kinh nghiệm thôi.
 
Upvote 0
Tôi có 1 danh sách có 10 tên ở cột A, cụ thể là từ ô A1 đến A10 . Tôi muốn dùng phím lên-xuống di chuyển từ từ từ A1 đến A10 , khi di chuyển đến đâu thì nội dung ô đó được hiện ở ô khác , ví dụ như ở ô B2 chẳng hạn ! Như vậy tôi dùng Bắt sự kiện KeyPressed trên Cell được không ? và cách dùng như thế nào ? Xin chỉ giúp , có ví dụ càng tốt
Xin cám ơn mọi người trước !
http://www.giaiphapexcel.com/forum/showthread.php?37919-Bắt-sự-kiện-KeyPressed-trên-Cell
 
Upvote 0
Tôi có 1 danh sách có 10 tên ở cột A, cụ thể là từ ô A1 đến A10 . Tôi muốn dùng phím lên-xuống di chuyển từ từ từ A1 đến A10 , khi di chuyển đến đâu thì nội dung ô đó được hiện ở ô khác , ví dụ như ở ô B2 chẳng hạn ! Như vậy tôi dùng Bắt sự kiện KeyPressed trên Cell được không ? và cách dùng như thế nào ? Xin chỉ giúp , có ví dụ càng tốt
Xin cám ơn mọi người trước !
http://www.giaiphapexcel.com/forum/showthread.php?37919-Bắt-sự-kiện-KeyPressed-trên-Cell

Khi di chuyển từ ô nọ qua ô kia, không có sự kiện Key_pressed trong cell, mà là Key pressed trên sheet. Bạn hãy dùng sự kiện Selection_Change.
 
Upvote 0
Tôi có 1 danh sách có 10 tên ở cột A, cụ thể là từ ô A1 đến A10 . Tôi muốn dùng phím lên-xuống di chuyển từ từ từ A1 đến A10 , khi di chuyển đến đâu thì nội dung ô đó được hiện ở ô khác , ví dụ như ở ô B2 chẳng hạn ! Như vậy tôi dùng Bắt sự kiện KeyPressed trên Cell được không ? và cách dùng như thế nào ? Xin chỉ giúp , có ví dụ càng tốt
Xin cám ơn mọi người trước !
Phần 1 trong câu hỏi của bạn Thầy Ptm đã trả lời, mình xin tiếp phần 2, bạn sử dụng code nì thử xem:
Mã:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("a1:a10")) Is Nothing Then [b2] = ActiveCell
End Sub
 
Upvote 0
KeyPress - 64-bit

Để chạy ví dụ trên Excel 64-bit cần sửa code như sau.

[GPECODE=vb]
Option Explicit

#If VBA7 Then
Declare PtrSafe Function SetWindowsHookEx Lib _
"user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, _
ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr

Declare PtrSafe Function CallNextHookEx Lib "user32" _
(ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr

Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Dim hhkLowLevelKybd As LongPtr

#Else
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

Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Declare Function GetActiveWindow Lib "user32" () As Long

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Dim hhkLowLevelKybd As Long
#End If

Const HC_ACTION = 0
Const WM_KEYDOWN = &H100
Const WH_KEYBOARD_LL = 13

Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type

#If VBA7 Then
Function Cell_OnKeyDown(ByVal nCode As Long, ByVal wParam As LongPtr, lParam As KBDLLHOOKSTRUCT) As LongPtr
#Else
Function Cell_OnKeyDown(ByVal nCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long
#End If
Dim keyCode As Long
keyCode = lParam.vkCode
If GetActiveWindow = FindWindow("XLMAIN", Application.Caption) Then
If (nCode = HC_ACTION) Then
If wParam = WM_KEYDOWN Then
' Xu ly su kien tai day
Select Case keyCode
Case vbKey0 To vbKey9, vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyF2, _
vbKeyReturn, vbKeyEscape, vbKeyBack, vbKeyDelete, vbKeyHome, vbKeyEnd, _
vbKeyTab
Cell_OnKeyDown = 0
Case Else
Cell_OnKeyDown = -1
Exit Function
End Select
End If
End If
End If
Cell_OnKeyDown = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function

Sub ActiveEvent(rng As Range)
Unhook_KeyBoard
hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf Cell_OnKeyDown, Application.Hinstance, 0)
SaveHookIDToReg hhkLowLevelKybd
End Sub

Public Sub Unhook_KeyBoard()
If hhkLowLevelKybd = 0 Then
hhkLowLevelKybd = GetHookIDfromReg()
End If
If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd
End Sub

Sub SaveHookIDToReg(ByVal nHookID As LongPtr)
SaveSetting "MyXlApp", "KEYBOARD", "HookID", nHookID
End Sub
Function GetHookIDfromReg() As LongPtr
GetHookIDfromReg = CLng(GetSetting("MyXlApp", "KEYBOARD", "HookID", 0))
End Function

[/GPECODE]
 
Upvote 0
tôi thử chạy code cuar bạng Nguyễn Duy Tuấn trên Excel-64 thấy báo lỗi như hình kèm theo

Lỗi xảy ra ở (Application.Hinstance)
Sub ActiveEvent(rng As Range)
Unhook_KeyBoard
hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf Cell_OnKeyDown, Application.Hinstance, 0)
SaveHookIDToReg hhkLowLevelKybd
End Sub
 

File đính kèm

  • Loi_Hinstance.jpg
    Loi_Hinstance.jpg
    4.8 KB · Đọc: 76
Upvote 0
tôi thử chạy code cuar bạng Nguyễn Duy Tuấn trên Excel-64 thấy báo lỗi như hình kèm theo

Lỗi xảy ra ở (Application.Hinstance)
Sub ActiveEvent(rng As Range)
Unhook_KeyBoard
hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf Cell_OnKeyDown, Application.Hinstance, 0)
SaveHookIDToReg hhkLowLevelKybd
End Sub

Nhờ anh Nguyen Duy Tuan sửa giúp lỗi code khi chạy trên excel 64
 
Upvote 0
Nhờ anh Nguyen Duy Tuan sửa giúp lỗi code khi chạy trên excel 64

Bạn sửa khai báo hàm "SetWindowsHookEx" trong nhánh #VBA7 như dưới đây xem ok không?
Public Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias
"SetWindowsHookExA" (ByVal idHook As LongLong, ByVal lpFn As LongPtr,
ByVal hmod As LongPtr, ByVal dwThreadId As LongLong) As LongLong
 
Upvote 0
Bạn sửa khai báo hàm "SetWindowsHookEx" trong nhánh #VBA7 như dưới đây xem ok không?
Public Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias
"SetWindowsHookExA" (ByVal idHook As LongLong, ByVal lpFn As LongPtr,
ByVal hmod As LongPtr, ByVal dwThreadId As LongLong) As LongLong

Vẫn không được bạn Nguyễn Duy Tuân ơi
 
Upvote 0
Gửi mọi người,

Tôi muốn nhập dữ liệu dạng số thập phân 123.45 thì phải sửa thế nào. Thanks
 
Upvote 0
Tôi xin gửi mọi người cùng tham khảo 1 phương pháp để bắt sự kiện KeyPressed trên 1 cell ngay cả khi đang edit, để từ đó có thể xử lý trực tiếp từng ký tự được nhập vào.
Trong file ví dụ tôi xử lý sự kiện cho ô A1(Xác định trong Worksheet_SelectionChange của Sheet1), và chỉ cho phép nhập các ký tự là số(từ 0 đến 9, sự kiện được xử lý tại hàm Cell_OnKeyDown của module)
Cho em hỏi là dùng cái trên có bị anti virus tấn công không?
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom