Excel VBA マウスカーソルの位置とセルを連携する

今回はマウスカーソルの位置から、セルを取得する方法をご説明します。

マウスカーソルの位置(座標)を取得する事で、座標に対応するセルを取得することができます。

また、マウスカーソルの位置から、取得したセルのデータを取得して、予め用意しているオートシェイプに、データを反映させる方法もご説明します。

1.マウスカーソルの位置を取得する

マウスカーソルの位置を取得するにはAPI関数の「GetCursorPos」を使用します。

次の説明するコードは標準モジュールに順番に記載します。

位置を取得するAPIの宣言

次のコードが「GetCursorPos」の宣言方法です。

標準モジュールの1番上に記述します。

'マウスカーソルの位置を取得するAPI
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

「GetCursorPos」の取得した結果を受け取るための構造体を準備します。

座標を取得する構造体

上記で記述したAPI関数の下に記述します。

「x」、「y」で宣言して取得します。

座標はx軸とy軸で表現されるので、こうした方がシンプルでわかりやすいです。

'位置座標用の構造体
Private Type POINTAPI
    x As Long
    y As Long
End Type

座標を取得して表示する

マウスカーソルの位置が取得できる準備ができましたので、メッセージボックスに表示するコードを構造体の下に書きます。

Sub Sample1()

Dim p As POINTAPI 'API用変数

GetCursorPos p 'カーソル位置取得

MsgBox "X座標：" & p.x & "　Y座標：" & p.y

End Sub

2.マウスカーソルとセルを連携させる

マウスカーソルの位置を取得できたので、マウスカーソルの位置をセルと連携させます。

セルと連携するには「RangeFromPoint」メソッドを使用します。

「RangeFromPoint」は「x、y」の位置にあるシェイプやRangeを返します。

この返されたRangeがマウスの位置にあるセルになります。

Sub Sample2()

Dim p        As POINTAPI 'API用変数
Dim Getcell  As Range

GetCursorPos p 'カーソル位置取得

Set Getcell = ActiveWindow.RangeFromPoint(p.x, p.y)

MsgBox "セルのアドレスは：" & Getcell.Address

End Sub

3.オートシェイプに取得したセルの値を表示

最後に予め用意しておいたオートシェイプに、マウスカーソルの位置から取得したセルの値を出力させるコードです。

次のようなオートシェイプ1個とA4～E30にランダムな数字を入力したサンプルデータを用意しました。

次のコードはマウスカーソルがデータの入力されたA4~E30の中に移動すると、取得したセルのデータをオートシェイプに表示します。

取得したマウスカーソルの位置からセルの変数に、セルを代入します。

「.Shapes(1).TextFrame.Characters.Text」でオートシェイプのテキストに取得したセルのデータを表示します。

ポイントは「Do While True」でループし続ける事と、ループ中に「Doevents」を2つ入れる事です。

「Doevents」は１つではカクカクします。

Option Explicit

'位置座標用の構造体
Private Type POINTAPI
    x As Long
    y As Long
End Type

'マウスカーソルの位置を取得するAPI
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Sub Sample3()

Dim p        As POINTAPI 'API用変数
Dim Getcell  As Range

On Error Resume Next

Do While True

    DoEvents
    DoEvents
    GetCursorPos p 'カーソル位置取得
    
    Set Getcell = ActiveWindow.RangeFromPoint(p.x, p.y)
    
    With ActiveSheet
    
        .Shapes(1).TextFrame.Characters.Text = Getcell.Value
        
    End With
    
Loop

End Sub