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

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

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

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

可是Excel2010和Excel2013无法使用，会弹出窗口：

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

代码：800A03EC

解决方法：

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

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

Option ExplicitDim WshShellDim oExcel, oBook, oModuleDim strRegKey, strCode, x, ySet 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/10x = oExcel.Run("GetXCursorPos") '获取鼠标 X 坐标y = oExcel.Run("GetYCursorPos") '获取鼠标 Y 坐标WScript.Echo x, yoExcel.Run "SetCursor", 30, 30 '设置鼠标 X Y 坐标Const MOUSEEVENTF_MOVE       = &H1Const MOUSEEVENTF_LEFTDOWN   = &H2Const MOUSEEVENTF_LEFTUP     = &H4Const MOUSEEVENTF_RIGHTDOWN  = &H8Const MOUSEEVENTF_RIGHTUP    = &H10Const MOUSEEVENTF_MIDDLEDOWN = &H20Const MOUSEEVENTF_MIDDLEUP   = &H40Const 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, 0oExcel.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'关闭 ExceloExcel.DisplayAlerts = FalseoBook.CloseoExcel.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 LongPrivate 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 = &H2Private Const MOUSEEVENTF_LEFTUP = &H4Private Sub Command1_Click()SetCursorPos 500, 500mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0End 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，通过。

...