七転八起SEの備忘録

Option Explicit

Dim x, y
Dim Excel

'シェルオブジェクトの作成
Set Excel = WScript.CreateObject("Excel.Application")

'キーコード
'Const VK_SHIFT = &H10

'マウス定数
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_ABSOLUTE = 32768
Const MOUSE_MOVE = &H1
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4


MouseMove 700 , 250　　'←ここで移動させたい座標を指定する
MouseClick


'クリック
Sub MouseClick
　Dim dwFlags
　dwFlags = MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP
　Call API_mouse_event(dwFlags, 0, 0, 0, 0)
　WScript.Sleep 100
End Sub

'マウスポインタ移動
Sub MouseMove(x, y)
　Dim pos_x, pos_y, dwFlags
　Const SCREEN_X = 1024
　Const SCREEN_Y = 768

　dwFlags = MOUSEEVENTF_ABSOLUTE + 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





※注1
利用するコンピュータにExcelが入っていることが条件

※注2
Windows10ではマウスポインタが移動しない可能性あり