用VBS控制鼠标(获取鼠标坐标、鼠标移动、鼠标单击、鼠标双击、鼠标右击)

标签: , , , , ,

不止一个人问过我怎样用VBS控制鼠标操作,比如:怎么用VBS获取鼠标指针的坐标位置?怎么用VBS移动鼠标?怎么用VBS模拟鼠标左键单击、左键双击、右键单击?……

网上搜到的答案普遍是VBS无法实现,或者是要用第三方COM(ActiveX?)组件。我对第三方组件是很反感的,使用第三方组件毫无可移植性可言,因为别人的系统中不一定注册了这个组件。我的建议是,尽量不要在VBS代码中调用第三方组件,除非你的程序只是写来自己用。(顺便说一下,也尽量不要用不靠谱的Sendkeys方法,原因不解释)

好了,废话就说这么多,现在说说用VBS控制鼠标的方法。我以前写过一篇《VBS调用Windows API函数》,本以为既然都能调用API了,用VBS控制鼠标还不是很简单是事?事实证明我错了,不明真相的同学永远是大多数,不知道API是什么的VBSer大有人在。不贴出实实在在的代码,他们根本不会自己写!

使用此代码的前提是你的系统上安装了Excel,因为要用到Excel.Application对象(如果你偏要认为这算第三方组件我也没话说):

Option Explicit
Dim WshShell
Dim oExcel, oBook, oModule
Dim strRegKey, strCode, x, y
Set oExcel = CreateObject("Excel.Application") '创建 Excel 对象
set WshShell = CreateObject("wscript.Shell")

strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM"
strRegKey = Replace(strRegKey, "$", oExcel.Version)
WshShell.RegWrite strRegKey, 1, "REG_DWORD"

Set oBook = oExcel.Workbooks.Add '添加工作簿
Set oModule = obook.VBProject.VBComponents.Add(1) '添加模块
strCode = _
"'Author: Demon"            & vbCrLf & _
"'Website: https://demon.tw" & vbCrLf & _
"'Date: 2011/5/10"          & vbCrLf & _
"Private Type POINTAPI : X As Long : Y As Long : End Type"                                                                                                                            & vbCrLf & _
"Private Declare Function SetCursorPos Lib ""user32"" (ByVal x As Long, ByVal y As Long) As Long"                                                                                     & vbCrLf & _
"Private Declare Function GetCursorPos Lib ""user32"" (lpPoint As POINTAPI) As Long"                                                                                                  & vbCrLf & _
"Private Declare Sub mouse_event Lib ""user32"" Alias ""mouse_event"" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)" & vbCrLf & _
"Public Function GetXCursorPos() As Long"                                                                                                                                             & vbCrLf & _
    "Dim pt As POINTAPI : GetCursorPos pt : GetXCursorPos = pt.X"                                                                                                                     & vbCrLf & _
"End Function"                                                                                                                                                                        & vbCrLf & _
"Public Function GetYCursorPos() As Long"                                                                                                                                             & vbCrLf & _
    "Dim pt As POINTAPI: GetCursorPos pt : GetYCursorPos = pt.Y"                                                                                                                      & vbCrLf & _
"End Function"
oModule.CodeModule.AddFromString strCode '在模块中添加 VBA 代码
'Author: Demon
'Website: https://demon.tw
'Date: 2011/5/10
x = oExcel.Run("GetXCursorPos") '获取鼠标 X 坐标
y = oExcel.Run("GetYCursorPos") '获取鼠标 Y 坐标
WScript.Echo x, y
oExcel.Run "SetCursorPos", 30, 30 '设置鼠标 X Y 坐标
Const MOUSEEVENTF_MOVE       = &H1
Const MOUSEEVENTF_LEFTDOWN   = &H2
Const MOUSEEVENTF_LEFTUP     = &H4
Const MOUSEEVENTF_RIGHTDOWN  = &H8
Const MOUSEEVENTF_RIGHTUP    = &H10
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP   = &H40
Const MOUSEEVENTF_ABSOLUTE   = &H8000
'模拟鼠标左键单击
oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
'模拟鼠标左键双击(即快速的两次单击)
oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
'模拟鼠标右键单击
oExcel.Run "mouse_event", MOUSEEVENTF_RIGHTDOWN + MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
'模拟鼠标中键单击
oExcel.Run "mouse_event", MOUSEEVENTF_MIDDLEDOWN + MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
'关闭 Excel
oExcel.DisplayAlerts = False
oBook.Close
oExcel.Quit

注释已经够详细了,要知道我很少写注释的,如果还看不懂,说明你的水平有待提高!

赞赏

微信赞赏支付宝赞赏

随机文章:

  1. 实现简单的VBS加密
  2. 可以用CreateObject创建的WMI对象
  3. VBS任意进制转换(实现PHP的base_convert函数)
  4. Unicode中的方框绘制字符
  5. 效率低下的Split函数,用VBS的人你伤不起

23 条评论 发表在“用VBS控制鼠标(获取鼠标坐标、鼠标移动、鼠标单击、鼠标双击、鼠标右击)”上

  1. 1说道:

    学习下

  2. slore说道:

    excel完全符合上面你对3方组件的说明。。。

  3. alphas说道:

    谢谢demon,终于实现了!

  4. Excalibur说道:

    LibreOffice能用么

  5. ayanmw说道:

    我在使用 wps……….
    可以改造下 做个判断 如果err.number>0 提示 没有安装Excel.
    可以使用notepad 作为demo 的.

  6. ayanmw说道:

    哦 我错了 原来是 VBA啊 …
    或许 你可以直接调用 vba组建.

  7. xiaoai说道:

    楼主,我在64位2010中运行上述脚本的时候 提示“无法运行”GetXcursor”宏。可能是因为该宏在此工作簿中不可用,或者所有的宏被禁用。
    请问是什么原因?找了半天也没找到- -谢谢

    • Tian说道:

      遇到了同样的问题。
      在Excel2013也会出现此错误

      • cnm说道:

        将上述相关的全部换成如下格式
        Public Sub clik(keydown)

        Select Case UCase(keydown)

        Case “LEFT”

        oExcel.Run “mouse_event”, &H2 + &H4, 0, 0, 0, 0

        Case “RIGHT”

        oExcel.Run “mouse_event”, &H8 + &H10, 0, 0, 0, 0

        Case “MIDDLE”

        oExcel.Run “mouse_event”, &H20 + &H40, 0, 0, 0, 0

        Case “DBCLICK”

        oExcel.Run “mouse_event”, &H2 + &H4, 0, 0, 0, 0

        oExcel.Run “mouse_event”, &H2 + &H4, 0, 0, 0, 0

        End Select

        End Sub

  8. __说道:

    挖个坟。看了代码,发现更改了Excel是否允许通过代码访问VBA对象模型的注册表键值。注意到这是使用CreateObject(“WScript.Shell”)实现的,那么理论上讲,我在JavaScript中也能用了咯?那我就可以通过在网页中嵌入相关代码悄悄更改Excel的 VBA安全设置,然后通过Office软件的VBA达到我不可告人的目的了咯?

    • 解集SS说道:

      JScript和JavaScript不是一个东西。在vbs中能用CreateObject(“WScript.Shell”)说明在JScript中能用(因为都是基于Windows Script Host(吧?)),但并不能说明在JavaScript中能用。

  9. 东京猫说道:

    作者,你才是大神,这段代码找好久了,膜拜膜拜,太好用了。

  10. 鼬鼠说道:

    感谢大佬

留下回复