Bắt sự kiện KeyPressed trên Cell (1 người xem)

[rollover79]

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)

 

[Nguyễn Duy Tuân]

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:

                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".

 

[rollover79]

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:

                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.

 

[Nguyễn Duy Tuân]

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.

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.

 

[levanduyet]

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.

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

 

[Nguyễn Duy Tuân]

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:

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

 

[rollover79]

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

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.

 

[Nguyễn Duy Tuân]

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.

 

[hungmo]

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

 

[ptm0412]

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.

 

[concogia]

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:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("a1:a10")) Is Nothing Then [b2] = ActiveCell
End Sub

 

[chautrungphan]

xảy ra lỗi khi chạy trên win 64 bit

 

[Nguyễn Duy Tuân]

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]

 

[chautrungphan]

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

 

[chautrungphan]

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

 

[Nguyễn Duy Tuân]

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

 

[chautrungphan]

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

 

[anhdepjai]

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

 

[NguyenNgocThuHien]

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?

 

[dazkangel]

Cho em hỏi là dùng cái trên có bị anti virus tấn công không?

bạn nên tạo bài mới rồi đường dẫn qua trang này, à bạn nên click chuột vào hình người muốn hỏi, như bạn trên đã không vào trang 1 năm rồi

 

[HeSanbi]

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

Vấn đề này đã lâu nhưng thấy chưa có câu trả lời, nên xin góp ý:
Một số phương thức ở 32bit không thể dùng ở 64bit, dù cho sử dụng tính tương thích ngược. Nên Microsoft mới thêm các phương thức mới để hỗ trợ tương thích với 64bit.
Ở đây, Application.Hinstance sẽ phải sửa thành Application.HinstancePtr

Sub ActiveEvent(rng As Range)
  Unhook_KeyBoard
  #If VBA7 And Win64 Then
    Dim LngHinstance As LongPtr
    LngHinstance = Application.HinstancePtr
  #Else
    Dim LngHinstance As Long
    LngHinstance = Application.Hinstance
  #End If
  hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf Cell_OnKeyDown, LngHinstance, 0)
  SaveHookIDToReg hhkLowLevelKybd
End Sub

 

[thuyyeu99]

Bắt event này giờ đã cũ, bạn co thể nghiên cứu bắt dược ký tự unicode và xóa từ trong cells do

 

[HeSanbi]

Bắt event này giờ đã cũ, bạn co thể nghiên cứu bắt dược ký tự unicode và xóa từ trong cells do

Bạn nói vậy chắc cách mới đó là mã nguồn đóng, nên cần phải nghiên cứu.
Tôi không rõ bạn nói bắt ký tự Unicode, nghe có vẻ lạ. Chắc là bạn nói các ký tự có dấu.
Tôi chỉ hiểu Unicode là một bảng mã ký tự được tiêu chuẩn hóa.

 

[thuyyeu99]

Bạn nói vậy chắc cách mới đó là mã nguồn đóng, nên cần phải nghiên cứu.
Tôi không rõ bạn nói bắt ký tự Unicode, nghe có vẻ lạ. Chắc là bạn nói các ký tự có dấu.
Tôi chỉ hiểu Unicode là một bảng mã ký tự được tiêu chuẩn hóa.

Tóm lại ý mình nói là : mình đánh vào chữ
Tớ là thủy
Và xóa chữ "là" thì nó bắt dược chữ "Tớ thủy".
Bạn làm dược hướng dẫn mình với nhé.
Thank you

 

[anhdepjai]

Vấn đề này đã lâu nhưng thấy chưa có câu trả lời, nên xin góp ý:
Một số phương thức ở 32bit không thể dùng ở 64bit, dù cho sử dụng tính tương thích ngược. Nên Microsoft mới thêm các phương thức mới để hỗ trợ tương thích với 64bit.
Ở đây, Application.Hinstance sẽ phải sửa thành Application.HinstancePtr

Sub ActiveEvent(rng As Range)
  Unhook_KeyBoard
  #If VBA7 And Win64 Then
    Dim LngHinstance As LongPtr
    LngHinstance = Application.HinstancePtr
  #Else
    Dim LngHinstance As Long
    LngHinstance = Application.Hinstance
  #End If
  hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf Cell_OnKeyDown, LngHinstance, 0)
  SaveHookIDToReg hhkLowLevelKybd
End Sub

Mình thử trong office 64 bit giờ không còn được nữa.
Trong bản windows 64bit ở máy khác kèm office 2016 cũng không được.
Nhờ mọi người giúp mình phần này với.
Ý tưởng là: khi gõ 1 cell chỉ định, nếu có ấn phím gì ngoài 0 1 2 3 4 5 6 7 8 9 Enter, Lên, Xuống, Trái, Phản, Backspace, Delete, Esc , Tab thì cell đều không nhận