1. 程式人生 > >用VBS控制鼠標,在Excel2010、2013,64位中

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

strong long 存在 找到 pen lar sheet class extra

原作者文章地址: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,通過。


...


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