热门标签 | HotTags
当前位置:  开发笔记 > 编程语言 > 正文

用VBS控制鼠标,在Excel2010、2013,64位中

原作者文章地址:http:demon.twprogrammingvbs-control-mouse.html感谢原作者的攻略,才使我学会用VBS控制鼠标。可是问题接踵而至,Excel2003和

原作者文章地址:http://demon.tw/programming/vbs-control-mouse.html

感谢原作者的攻略,才使我学会用VBS控制鼠标。

可是问题接踵而至,Excel2003和Excel2007环境下,按文章做完全没问题。

可是Excel2010和Excel2013无法使用,会弹出窗口:

错误:无法运行“SetCursorPos”宏。可能是因为该宏在此工作薄中不可用,或者所有的宏都被禁用。

代码:800A03EC


解决方法:

在宏设置中启用所有宏;在自定义功能区在开发工具前打对号。

然后用以下代码便可以解决此问题。

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 = _
"Private Type POINTAPI : X As Long : Y As Long : End Type" & vbCrLf & _
"Private Declare PtrSafe Function SetCursorPos Lib ""user32"" (ByVal x As Long, ByVal y As Long) As Long" & vbCrLf & _
"Private Declare PtrSafe Function GetCursorPos Lib ""user32"" (lpPoint As POINTAPI) As Long" & vbCrLf & _
"Private Declare PtrSafe 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" & vbCrLf & _
"Private Sub SetCursor(x,y)" & vbCrLf & _
"SetCursorPos x, y" & vbCrLf & _
"End Sub"
oModule.CodeModule.AddFromString strCode '在模块中添加 VBA 代码
'Author: Demon
'Website: http://demon.tw
'Date: 2011/5/10
x = oExcel.Run("GetXCursorPos") '获取鼠标 X 坐标
y = oExcel.Run("GetYCursorPos") '获取鼠标 Y 坐标
WScript.Echo x, y
oExcel.Run "SetCursor", 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

新增内容:我在原作者的代码上,只是在Declare后加入PtrSafe而已。另外新加了个函数,SetCursor,用来代替原代码的SetCursorPos。

问题解释:只是因为64位Excel使用Declare会有错误罢了。另外如果不用我新增的SetCursor的话,使用SetCursorPos会使鼠标移动到屏幕右上方,不知道原因。

啊啊啊啊啊啊啊,这个问题烦了我好长时间,我去各VBS论坛VBS群问,都毫无结果,我又去VBA论坛问,也毫无结果,原作者在原文章评论也不回我啊啊啊啊啊。

于是..完全不会VBA的我,开始研究VBA..


1.在VBS中运行以下代码,并没有出错。这说明VBS调用Excel2010并没有问题。

dim oExcel,oWb,oSheet 
Set oExcel= CreateObject("Excel.Application")
Set oWb = oExcel.Workbooks.Open("C:\Users\Administrator\Desktop\Book1.xls")
Set oSheet = oWb.Sheets("Sheet1")
MsgBox oSheet.Range("B2").Value '#提取单元格B2内容

2.研究明白了一点VBA,

Sub tian()
MsgBox "测试远程脚本是否可以启动", 0 + 64, "试验窗口"
End Sub
在Excel中按Alt+F11,便可以打开VBA编辑框,输入以上代码可以成功运行。

然后把它放在VBS中,也可以使用,这说明并不是VBA的问题。

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 = _
"Sub Tian()" & vbCrLf & _
"MsgBox ""tian"",64,""D""" & vbCrLf & _
"End Sub"
oModule.CodeModule.AddFromString strCode '在模块中添加 VBA 代码
oExcel.Run "tian"
'关闭 Excel
oExcel.DisplayAlerts = False
oBook.Close
oExcel.Quit
3.此VBA代码在Excel2003中可以正常运行,而Excel2010并不可以。

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) 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_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Sub Command1_Click()
SetCursorPos 500, 500
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
并提示错误:

编译错误:

若要在64位系统上使用,则必须更新此项目中的代码。请检查并更新Declare语句,然后用PtrSafe属性标记它们。


貌似终于找到问题所在了!哈哈哈哈。

4.查了一下,虽然不是很懂,总之是把PtrSafe放到Declare后面吧。

竟然可以使用,放在VBS里也没有问题

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 = _
"Private Declare PtrSafe Function SetCursorPos Lib ""user32"" (ByVal x As Long, ByVal y As Long) As Long" & vbCrLf & _
"Private 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)" & vbCrLf & _
"Private Const MOUSEEVENTF_LEFTDOWN = &H2" & vbCrLf & _
"Private Const MOUSEEVENTF_LEFTUP = &H4" & vbCrLf & _
"Private Sub Command1_Click()" & vbCrLf & _
"SetCursorPos 500, 500" & vbCrLf & _
"mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0" & vbCrLf & _
"mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0" & vbCrLf & _
"End Sub"
oModule.CodeModule.AddFromString strCode '在模块中添加 VBA 代码
oExcel.Run "Command1_Click"
'关闭 Excel
oExcel.DisplayAlerts = False
oBook.Close
oExcel.Quit

5.虽然问题解决了,但是在原作者的代码的Declare后面加上PtrSafe后,存在问题,无论把SetCursorPos设成什么值,鼠标都只会移到右上角。

于是,加上函数SetCursor,通过。


...



推荐阅读
author-avatar
Less哒哒_288
这个家伙很懒,什么也没留下!
PHP1.CN | 中国最专业的PHP中文社区 | DevBox开发工具箱 | json解析格式化 |PHP资讯 | PHP教程 | 数据库技术 | 服务器技术 | 前端开发技术 | PHP框架 | 开发工具 | 在线工具
Copyright © 1998 - 2020 PHP1.CN. All Rights Reserved | 京公网安备 11010802041100号 | 京ICP备19059560号-4 | PHP1.CN 第一PHP社区 版权所有