Dò tìm vị trí của chuột trên màn hình

[tuhocvba]

Chủ đề dò tìm vị trí của chuột trên màn hình khá thú vị, vì nó là cơ sở để giải quyết bài toán tạo các ứng dụng tự động (can thiệp vào ứng dụng khác thông qua các sự kiện click và di chuyển chuột).

Detect Mouse Movement :

Public Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Public Type POINTAPI

x As Long

y As Long

End Type




Sub PositionXY()

Dim lngCurPos As POINTAPI

Do

GetCursorPos lngCurPos

Range("A1").Value = "X: " & lngCurPos.x & " Y: " & lngCurPos.y

DoEvents

Loop

End Sub

Đã test trên win 7, office 2013, chạy rất tốt.

Bạn cần đăng nhập để thấy hình ảnh

Nguồn tham khảo:

Bạn cần đăng nhập để thấy link

 

[vbano1]

Như vậy chúng ta có thể ghi lại toàn bộ các vị trí mà chúng ta click chuột trái.

'Declare mouse events
'Public Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
'Public Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
'Public Const MOUSEEVENTF_LEFTDOWN = &H2
'Public Const MOUSEEVENTF_LEFTUP = &H4
'Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
'Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
''Declare sleep
'Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Declare PtrSafe Function GetKeyState Lib "user32.dll" (ByVal KeyCode As Long) As Integer
Const VK_LBUTTON = &H1
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public cnt As Long
Public Type POINTAPI

x As Long

y As Long


End Type
Sub test()
Dim lngCurPos As POINTAPI
cnt = 1
    Do

    GetCursorPos lngCurPos
 

    DoEvents
If GetAsyncKeyState(1) Then


ThisWorkbook.Sheets(1).Cells(cnt, 1).Value = "X: " & lngCurPos.x & " Y: " & lngCurPos.y
cnt = cnt + 1
End If
Loop


End Sub

Đã test trên win7, office 2013.
Nguồn tham khảo:

Bạn cần đăng nhập để thấy link

Bạn cần đăng nhập để thấy link

 

[Euler]

Như vậy chúng ta có thể ghi lại toàn bộ các vị trí mà chúng ta click chuột trái.

Cần cải thiện code một chút để tránh ghi tọa độ trùng lặp liên tục.
Thao tác con người ấn chuột cần cỡ 300ms. Macro sẽ ghi liên tục trong 300ms này cho nên tọa độ trùng lặp liên tục. Vì vậy chúng ta cần tạo thời gian ngủ sau mỗi lần ghi thao tác click chuột.

'Declare mouse events
'Public Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
'Public Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
'Public Const MOUSEEVENTF_LEFTDOWN = &H2
'Public Const MOUSEEVENTF_LEFTUP = &H4
'Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
'Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
''Declare sleep
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Declare PtrSafe Function GetKeyState Lib "user32.dll" (ByVal KeyCode As Long) As Integer
Const VK_LBUTTON = &H1
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public cnt As Long
Public Type POINTAPI

x As Long

y As Long


End Type
Sub test()
    Dim lngCurPos As POINTAPI
    cnt = 1
    Do

    GetCursorPos lngCurPos
  

    DoEvents
    If GetAsyncKeyState(1) Then
    
        
         ThisWorkbook.Sheets(1).Cells(cnt, 1).Value = "X: " & lngCurPos.x & " Y: " & lngCurPos.y
         cnt = cnt + 1
         Sleep 300
    End If
    Loop
End Sub

 

[tuhocvba]

Bạn cần đăng nhập để thấy hình ảnh

Kết quả test code thực tế:

 

[Nguyễn Quốc Cường]

Em là gà excel , e ko hiểulaf lấy dc toạ độ chuột click thì mình có thể click lại như thế bằng code VBA ko ạ

 

[tuhocvba]

Bạn tham khảo ở đây:

Bạn cần đăng nhập để thấy link