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

2015年10月11日20:25:28Excel880–VBA控制鼠标移动到任意位置已关闭评论 11,227 views
微信公众号 【EXCEL880】 QQ群【165159540】
课程咨询 加我微信EXCEL880B试学网址http://v.excel880.com

有些操作没法用代码直接取得控制权 就需要模拟鼠标移动点击以及键盘操作 关于键盘操作的大部分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