エクセルシート上のマウス座標

はじめに

　エクセルGISとかできないかと思い、エクセルシート上のマウス座標を取得できないかと思ってたら、そういった関数がないようだったので綴る。

概要

　マウスのポジションを取得するAPIでウィンドウ上の座標を取得。RangeFormPointと.Addressで該当する座標にあるセルを取得、近くのセルまでの距離を計測セルの座標からカーソル位置を逆算という流れ。
　なお、セルの枠上の判定をきちんと確かめていないため、誤差が1pxくらいある。

注意

• クリックで実行とかじゃないので、シート上で実行ボタンを押すか、ボタンを配置しましょう
• シート外で実行するとエラーを吐きます。
• 拡大率100%でのみ正しく動作します。
• セルは一律高さ：18px、幅：72pxで計算してます。
  セルの幅(ピクセル)を取得する関数とかあれば、幅変更にも対応できるんじゃないかなたぶん
• ウィンドウのサイズが変わっても座標は計算可
• ざっと書いたのでコードが汚いです。

Option Explicit

Declare Function GetCursorPos Lib "user32" (IpPoint As POINTAPI) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type

Sub エクセルシート座標計算()
    Dim p As POINTAPI
    Dim MusPtCell
    Dim xMusPt, yMusPt
    Dim CrnPos, CcnPos
    Dim xMusPtSheet, yMusPtSheet
    Dim i

    'マウス下のセル番地を取得
    GetCursorPos p
    Set MusPtCell = ActiveWindow.RangeFromPoint(p.x, p.y)
    MusPtCell = MusPtCell.Address
    
    xMusPtSheet = -1
    yMusPtSheet = -1

    'マウス下のセルの左上端の座標化
    CrnPos = (Range(MusPtCell).Column - 1) * 72
    CcnPos = (Range(MusPtCell).Row - 1) * 18
    
    '隣のセルまでの距離(ピクセル)
    For i = 1 To 72
       'x左方向
       If Not xMusPtSheet = -1 Then
          If Not yMusPtSheet = -1 Then Exit For
       ElseIf Not CrnPos = 0 Then
          Set xMusPt = ActiveWindow.RangeFromPoint(p.x - i, p.y)
          xMusPt = xMusPt.Address
          If Not xMusPt = MusPtCell Then
             'マウス下のセルの左上端の座標化しシート上の座標を計算
             xMusPtSheet = CrnPos + i
          End If
       Else
          Set xMusPt = ActiveWindow.RangeFromPoint(p.x + i, p.y)
          xMusPt = xMusPt.Address
          If Not xMusPt = MusPtCell Then
            'マウス下のセルの右下端の座標化しシート上の座標を計算
             xMusPtSheet = Range(MusPtCell).Column * 72 - i
          End If
       End If
       'y上方向
       If Not yMusPtSheet = -1 Then
          If Not xMusPtSheet = -1 Then Exit For
       ElseIf Not CcnPos = 0 Then
          Set yMusPt = ActiveWindow.RangeFromPoint(p.x, p.y - i)
           yMusPt = yMusPt.Address
          If Not yMusPt = MusPtCell Then
             'マウス下のセルの左上端の座標化しシート上の座標を計算
              yMusPtSheet = CcnPos + i
          End If
       Else
          Set yMusPt = ActiveWindow.RangeFromPoint(p.x, p.y + i)
           yMusPt = yMusPt.Address
          If Not yMusPt = MusPtCell Then
            'マウス下のセルの右下端の座標化しシート上の座標を計算
              yMusPtSheet = Range(MusPtCell).Row * 18 - i
          End If
       End If
    Next
    
    MsgBox "x:" & xMusPtSheet & ",y:" & yMusPtSheet

End Sub