前回(VBScriptでPrintscreen・Alt+Printscreenしてみた)の続きで。VBScriptからマウスを操作するコードのメモ。
ExcelのCall関数でAPIを叩く部分（API_～）とそのラッパの二段構成。

ExecuteGlobal CreateObject("Scripting.FileSystemObject").OpenTextFile("MouseController.vbs", 1, False).ReadAll()
'***************************************
'Simplae Test
'***************************************
Dim myPoint, x, y
myPoint = API_GetMessagePos
x = myPoint(0)
y = myPoint(1)
MsgBox "x = " & x & vbCrLf & "y = " & y
MouseMove x + 100, y + 100
MouseClick
MsgBox "クリックしました"
MouseMove 1000, 500
MouseClickShift
MsgBox "Shift + クリックしました"
MouseMove 1000, 300
DoubleClick
MsgBox "ダブルクリックしました"
view raw [TEST]MouseController.vbs hosted with ❤ by GitHub
Set Excel = WScript.CreateObject("Excel.Application")
'キーコード
Const VK_SHIFT = &H10
'マウス定数
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSE_MOVE = &H1
Const MOUSEEVENTF_LEFTDOWN = &H2
COnst MOUSEEVENTF_LEFTUP = &H4
'クリック
Sub MouseClick
Dim dwFlags
dwFlags = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP
Call API_mouse_event(dwFlags, 0, 0, 0, 0)
WScript.Sleep 100
End Sub
'SHIFT+クリック
Sub MouseClickShift
Dim dwFlags
Call API_keybd_event(VK_SHIFT,0,1,0)
dwFlags = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP
Call API_mouse_event(dwFlags, 0, 0, 0, 0)
Call API_keybd_event(VK_SHIFT,0,3,0)
WScript.Sleep 100
End Sub
'ダブルクリック
Sub DoubleClick
MouseClick
MouseClick
End Sub
'マウスポインタ移動
Sub MouseMove(x, y)
Dim pos_x, pos_y, dwFlags
Const SCREEN_X = 1024
Const SCREEN_Y = 768
dwFlags = MOUSEEVENTF_ABSOLUTE Or MOUSE_MOVE
pos_x = Int(x * 65535 / SCREEN_X)
pos_y = Int(y * 65535 / SCREEN_Y)
Call API_mouse_event(dwFlags, pos_x, pos_y, 0, 0)
WScript.Sleep 100
End Sub
'************************
'APIを叩く処理
'************************
Sub API_mouse_event(dwFlags, dx, dy, dwData, dwExtraInfo)
Dim strFunction
Const API_STRING = "CALL(""user32"",""mouse_event"",""JJJJJj"", $1, $2, $3, $4, $5)"
strFunction = Replace(Replace(Replace(Replace(Replace(API_STRING, "$1", dwFlags), "$2", dx), "$3", dy), "$4", dwData), "$5", dwExtraInfo)
Call Excel.ExecuteExcel4Macro(strFunction)
End Sub
Sub API_keybd_event(bVk, bScan, dwFlags, dwExtraInfo)
Dim strFunction
Const API_STRING = "CALL(""user32"",""keybd_event"",""JJJJJ"", $1, $2, $3, $4)"
strFunction = Replace(Replace(Replace(Replace(API_STRING, "$1", bVk), "$2", bScan), "$3", dwFlags), "$4", dwExtraInfo)
Call Excel.ExecuteExcel4Macro(strFunction)
End Sub
Function API_GetMessagePos()
Dim ret, strHex, x, y
Dim strFunction
Const API_STRING = "CALL(""user32"",""GetMessagePos"",""J"")"
strFunction = API_STRING
ret = Excel.ExecuteExcel4Macro(strFunction)
strHex = Right("00000000" & Hex(ret), 8)
x = CLng("&H" & Right(strHex, 4))
y = CLng("&H" & Left(strHex, 4))
API_GetMessagePos = Array(x, y)
End Function
view raw MouseController.vbs hosted with ❤ by GitHub

参考URL

関連する公式情報はこのあたり