vba模拟鼠标点击问题

许宏洲 2022-05-24 08:23:02

做了一个vba模拟鼠标点击的宏，功能是点击wps上的菜单实现相就的功能，发现wps vba的运行机制是先把宏运行完，再让显示菜单，不知道有没有办法让wps在宏点击运行时，实时出现需要的菜单？

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


'鼠标移动和点击模块
Private Declare 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)
Private Const MOUSEEVENTF_ABSOLUTE = &H8000    '指定鼠标使用绝对坐标系，此时，屏幕在水平和垂直方向上均匀分割成65535×65535个单元
Private Const MOUSEEVENTF_MOVE = &H1    '移动鼠标
Private Const MOUSEEVENTF_LEFTDOWN = &H2    '模拟鼠标左键按下
Private Const MOUSEEVENTF_LEFTUP = &H4    '模拟鼠标左键抬起
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long    '获取分辨率
Type POINTAPI
    x As Long
    y As Long
End Type


Private Sub Screen_Click(ByVal x As Long, ByVal y As Long)    '移动并点击
    mw = x / GetSystemMetrics32(0) * 65535
    mh = y / GetSystemMetrics32(1) * 65535
    mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, mw, mh, 0, 0
    mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Public Function getmouse_x_y() As POINTAPI    '坐标
    GetCursorPos getmouse_x_y

End Function
Sub DisplayMonitorInfo()
    Dim x As Long, y As Long
    x = GetSystemMetrics32(0)    ' 宽度（像素）
    y = GetSystemMetrics32(1)    ' 高度（像素）
    MsgBox "屏幕分辨率为：" & x & " × " & y & " 像素"
End Sub
Sub GetPosition()    '获得坐标
    Debug.Print getmouse_x_y.x, getmouse_x_y.y

End Sub
Sub test()
    SetCursorPos 850, 130
    mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    
    Sleep 500
    SetCursorPos 620, 265
    mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    
    Sleep 500
    SetCursorPos 1050, 385
    Sleep 500
    mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    
    'Screen_Click [D 2], [D3]
End Sub

...全文