【VBA】マウスの座標を取得する

VBAでマウスの座標を取得してみます。
座標を取得するコードの応用方法も後半に掲載しています。

マウスの座標を取得する

マウスの座標を取得するにはWindowsAPIのGetCursorPosを使用します。

 1Option Explicit
 2Type coordinate
 3    x As Long
 4    y As Long
 5End Type
 6Declare Function GetCursorPos Lib "User32" (lpPoint As coordinate) As Long
 7
 8Sub getMouseCoordinate()
 9
10  Dim c As coordinate
11  GetCursorPos c
12  MsgBox "x座標は" & c.x & " y座標は" & c.y
13  
14End Sub
1Type coordinate
2    x As Long
3    y As Long
4End Type

GetCursorPosの結果を受け取るための構造体を事前に宣言します。

1Declare Function GetCursorPos Lib "User32" (lpPoint As coordinate) As Long

Declare文を利用して、WindowsAPIのGetCursorPosを宣言します。

1Dim c As coordinate
2  GetCursorPos c
3  MsgBox "x座標は" & c.x & " y座標は" & c.y

GetCursorPos cでマウスの現在位置を取得します。
座標位置は構造体内の各変数名(今回であればxとy)を使用して取得します。

ステータスバーにマウスの現在位置を表示する

ステータスバーに現在のマウスの位置の座標を表示してみます。

 1Option Explicit
 2Type coordinate
 3    x As Long
 4    y As Long
 5End Type
 6Declare Function GetCursorPos Lib "User32" (lpPoint As coordinate) As Long
 7
 8Sub getMouseCoordinateFiveSeconds()
 9
10  Dim c As coordinate
11  Dim startTime As Double
12  Dim endTime As Double
13  startTime = Timer
14  Do While Timer - startTime <= 5
15    GetCursorPos c
16    Application.StatusBar = c.x & " " & c.y
17    endTime = Timer
18  Loop
19
20  Application.StatusBar = False
21  
22End Sub

コードを実行すると、ステータスバーにマウスの現在位置が5秒間表示されます。

マウスの移動を再現する

事前に座標を保存しておくと、設定しておいた位置にマウスを動かせます。

下記のコードsaveCoordinatesを実行すると、「座標」シートにマウスで左クリックした座標位置を書き込みます。
マウスの左クリックの判定にはWindowsAPIのGetAsyncKeyStateを使用します。

 1Option Explicit
 2
 3Declare Function GetAsyncKeyState Lib "User32" (ByVal vKey As Long) As Integer
 4Declare Function GetCursorPos Lib "User32" (lpPoint As coordinate) As Long
 5Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
 6
 7Sub saveCoordinates()
 8  
 9  Dim sht As Worksheet
10  Set sht = ThisWorkbook.Worksheets("座標")
11  
12  Const CLICKNUM As Long = 3
13  
14  Dim currentClickNum As Long
15  currentClickNum = 0
16  Do While currentClickNum < CLICKNUM
17    If GetAsyncKeyState(1) < 0 Then
18      currentClickNum = currentClickNum + 1
19      Dim c As coordinate
20      GetCursorPos c
21      sht.Cells(1 + currentClickNum, 2) = c.x
22      sht.Cells(1 + currentClickNum, 3) = c.y
23      Sleep 100
24    End If
25  Loop
26  
27  Set sht = Nothing
28
29End Sub

座標位置をシートに取得後、下記のloadCoordinatesを実行すると座標シートに記録した位置にマウスカーソルを移動します。
マウスカーソルの移動にはWindowsAPIのSetCursorPosを使用します。

 1Option Explicit
 2Declare Function SetCursorPos Lib "User32" (ByVal x As Long, ByVal y As Long) As Long
 3Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
 4
 5Sub loadCoordinates()
 6  
 7  Dim sht As Worksheet
 8  Set sht = ThisWorkbook.Worksheets("座標")
 9  
10  Const CLICKNUM As Long = 3
11  
12  Dim currentClickNum As Long
13  Dim i As Long
14  
15  For i = 1 To 3
16    Dim x As Long
17    Dim y As Long
18    x = sht.Cells(i + 1, 2)
19    y = sht.Cells(i + 1, 3)
20    SetCursorPos x, y
21    Sleep 1000
22  Next i
23  
24  Set sht = Nothing
25
26End Sub

マウスクリックのWindowsAPIと組み合わせると指定した位置の座標を自動でクリックしていくツールを作成できます。
ただ、VBAで作成する必要がなければフリーソフトを使用したほうが工数はかからないです。

マウス用ユーティリティ - Vector

関連ページ