Excel880–VBA控制鼠标移动到任意位置

2015年10月11日20:25:28 评论 9,364 views
表格 定制  数据 合并 处理 分析 VBA 编程 开发 网页

有些操作没法用代码直接取得控制权 就需要模拟鼠标移动点击以及键盘操作 关于键盘操作的大部分sendkeys就可以了 而鼠标移动点击就要麻烦许多 老规矩百度了一番 找到一部分代码  重新整理组合了一下 实现了Excel vba版本 前几日在给一个客户做的项目中就用到了 程序目标打开一个exe文件然后点击某个区域 通过那个程序获得数据 模拟点击效果如下 废话少说上代码 (代码区双击复制)

'鼠标移动和点击模块,整理by Excel880工作室 QQ80871835 VBA有偿服务 欢迎咨询
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 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
    [D2] = getmouse_x_y.X
    [D3] = getmouse_x_y.Y
End Sub
Sub test()
    Screen_Click [D2], [D3]
End Sub

示例文件下载      鼠标移动点击.rar

  • 郑广学老师微信号
  • EXCEL880B
  • weinxin
  • 我的微信公众号
  • EXCEL880
  • weinxin
表格 定制  数据 合并 处理 分析 VBA 编程 开发 网页

发表评论

您必须才能发表评论!