MyException - 我的异常网
当前位置:我的异常网» VB » 用VBS统制鼠标,在Excel2010、2013,64位中

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

www.MyException.Cn  网友分享于:2015-08-22  浏览:0次
用VBS控制鼠标,在Excel2010、2013,64位中

原作者文章地址: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 & _
<span style="white-space:pre">	</span>"Dim pt As POINTAPI : GetCursorPos pt : GetXCursorPos = pt.X"   & vbCrLf & _
"End Function"    & vbCrLf & _
"Public Function GetYCursorPos() As Long"  & vbCrLf & _
<span style="white-space:pre">	</span>"Dim pt As POINTAPI: GetCursorPos pt : GetYCursorPos = pt.Y"  & vbCrLf & _
"End Function" & vbCrLf & _
"Private Sub SetCursor(x,y)" & vbCrLf & _ 
<span style="white-space:pre">	</span>"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,通过。


...


版权声明:本文为博主原创文章,未经博主允许不得转载。

文章评论

Java程序员必看电影
Java程序员必看电影
Google伦敦新总部 犹如星级庄园
Google伦敦新总部 犹如星级庄园
2013年中国软件开发者薪资调查报告
2013年中国软件开发者薪资调查报告
一个程序员的时间管理
一个程序员的时间管理
我是如何打败拖延症的
我是如何打败拖延症的
我的丈夫是个程序员
我的丈夫是个程序员
程序员周末都喜欢做什么?
程序员周末都喜欢做什么?
聊聊HTTPS和SSL/TLS协议
聊聊HTTPS和SSL/TLS协议
60个开发者不容错过的免费资源库
60个开发者不容错过的免费资源库
什么才是优秀的用户界面设计
什么才是优秀的用户界面设计
程序员应该关注的一些事儿
程序员应该关注的一些事儿
旅行,写作,编程
旅行,写作,编程
那些争议最大的编程观点
那些争议最大的编程观点
鲜为人知的编程真相
鲜为人知的编程真相
为什么程序员都是夜猫子
为什么程序员都是夜猫子
如何成为一名黑客
如何成为一名黑客
“肮脏的”IT工作排行榜
“肮脏的”IT工作排行榜
初级 vs 高级开发者 哪个性价比更高?
初级 vs 高级开发者 哪个性价比更高?
程序员的鄙视链
程序员的鄙视链
老美怎么看待阿里赴美上市
老美怎么看待阿里赴美上市
亲爱的项目经理,我恨你
亲爱的项目经理,我恨你
 程序员的样子
程序员的样子
看13位CEO、创始人和高管如何提高工作效率
看13位CEO、创始人和高管如何提高工作效率
2013年美国开发者薪资调查报告
2013年美国开发者薪资调查报告
我跳槽是因为他们的显示器更大
我跳槽是因为他们的显示器更大
程序员必看的十大电影
程序员必看的十大电影
做程序猿的老婆应该注意的一些事情
做程序猿的老婆应该注意的一些事情
中美印日四国程序员比较
中美印日四国程序员比较
代码女神横空出世
代码女神横空出世
程序员的一天:一寸光阴一寸金
程序员的一天:一寸光阴一寸金
编程语言是女人
编程语言是女人
程序员和编码员之间的区别
程序员和编码员之间的区别
那些性感的让人尖叫的程序员
那些性感的让人尖叫的程序员
如何区分一个程序员是“老手“还是“新手“?
如何区分一个程序员是“老手“还是“新手“?
5款最佳正则表达式编辑调试器
5款最佳正则表达式编辑调试器
“懒”出效率是程序员的美德
“懒”出效率是程序员的美德
总结2014中国互联网十大段子
总结2014中国互联网十大段子
漫画:程序员的工作
漫画:程序员的工作
要嫁就嫁程序猿—钱多话少死的早
要嫁就嫁程序猿—钱多话少死的早
Web开发人员为什么越来越懒了?
Web开发人员为什么越来越懒了?
Java 与 .NET 的平台发展之争
Java 与 .NET 的平台发展之争
当下全球最炙手可热的八位少年创业者
当下全球最炙手可热的八位少年创业者
科技史上最臭名昭著的13大罪犯
科技史上最臭名昭著的13大罪犯
每天工作4小时的程序员
每天工作4小时的程序员
十大编程算法助程序员走上高手之路
十大编程算法助程序员走上高手之路
10个调试和排错的小建议
10个调试和排错的小建议
写给自己也写给你 自己到底该何去何从
写给自己也写给你 自己到底该何去何从
不懂技术不要对懂技术的人说这很容易实现
不懂技术不要对懂技术的人说这很容易实现
程序员都该阅读的书
程序员都该阅读的书
软件开发程序错误异常ExceptionCopyright © 2009-2015 MyException 版权所有