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

2018年11月01日 · 3 分で読了 · 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 &lt;= 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 &lt; CLICKNUM
17    If GetAsyncKeyState(1) &lt; 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