Lưu tọa độ khi click chuột

[quanglv124]

Dears,
Em muốn record lại tọa độ màn hình khi click chuột trên một màn hình application khác mà không biết làm thế nào. Các bác share file mẫu giúp em với.

Thank you all,

 

[ThangCuAnh]

Khổ ghê, nhiều topic loại này. VBA mà cứ đòi dùng API, can thiệp sâu vào Windows. Như cứ đòi chạy xe bò trên đường cao tốc.
Hì hì, thôi, quay lại chủ đề, bạn chịu khó gấu gồ nha: WH_MOUSE_LL and SetWindowsHookEx and VBA

Detect System Wide Mouse Events

How to detect system wide mouse events in your application

www.codeproject.com

 

[VetMini]

Khổ ghê, nhiều topic loại này. VBA mà cứ đòi dùng API, can thiệp sâu vào Windows. Như cứ đòi chạy xe bò trên đường cao tốc.
...

Khả năng nắm bắt và khiển dữ liệu chỉ có hạn. Nếu không tìm cách bày trò múa rối thì người ta nghĩ rằng mình kém.

 

[ThangCuAnh]

Không hiểu ý bác VetMini

 

[khongtu19bk]

Tạm thời trên VBA tìm được code này, dò tìm trạng thái di chuyển chuột. Chưa đáp ứng được yêu cầu của bạn là tại vị trí click, nhưng vẫn đưa ra vì biết đâu có ích cho bạn.

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

Nguồn tham khảo link.
here

 

[khongtu19bk]

Cuối cùng thì cũng đã code được.

'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

 

[quanglv124]

Cuối cùng thì cũng đã code được.

'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

Hay quá, Thank you bác!!!!!!!!!!!!!!!

 

[ThangCuAnh]

Vậy áp dụng, call hàm test ra sao bạn ?

 

[ThangCuAnh]

Thế thời gian, CPU còn đâu nữa cho Excel chạy bạn ? Chạy code này xong ngồi ngó thôi hả bạn?

 

[khongtu19bk]

Excel vẫn hoạt động trong khi bạn click làm việc với các ứng dụng khác, cụ thể như trong minh hoạ, tôi thao tác với web và excel ghi lại các thao tác click.