Excelのシート上のマウスポインタの座標をマクロで取得して描画する方法

GetCursorPosだけでは座標を取得できずかなり大変でした。 まだ若干ずれる時がありますが、もっと良い方法があればコメント頂けたら嬉しいです。

GetCursorPos使用の宣言

Excel VBAマクロの全てのSubより上に宣言します。
Type coordinateは座標用の構造体。
Private Declare部分はWin32とWin64でGetCursorPos()が使用できるように宣言。 

Type COORDINATE
    x As Long
    y As Long
End Type
#If Win64 Then
    Private Declare PtrSafe Function GetCursorPos Lib "User32" (lpPoint As COORDINATE) As Long
#Else
    Private Declare Function GetCursorPos Lib "User32" (lpPoint As coordinate) As Long
#End If

Windowsの座標からExcelの座標に変換

  1. GetCursorPosでWindows座標を取得
  2. ActiveWindow.VisibleRange.Range(“A1”)でExcelシートの左上の座標をPointで取得して、Pixelでのシートの左上の座標を得る。
  3. Excelのシートの左上の座標+シート上でのPointでの座標でマウスポインタの位置を取得
  4. シートの拡大率により調整

式を見たら、結局ActiveWindow.VisibleRange.Range(“A1”).Topや.Leftとなりそうですが、これだけを入力すると場所がずれます。 多分、PixcelとPointで計算に差が出るのかもしれません。 AddConnectorはSingle型以外エラーとなるので、Csngで型変更(cast)しています。 シートの拡大率が100%でなくても使えるよう、ActiveWindow.Zoomで位置が合うようにしています。

Function getExcelCusorPos() As x_y
Dim c As COORDINATE
Dim x1 As Long, y1 As Long
Dim x2 As Long, y2 As Long
   
   Call GetCursorPos(c)
    y1 = ActiveWindow.PointsToScreenPixelsY((ActiveWindow.VisibleRange.Range("A1").Top) * 96 / 72)
    x1 = ActiveWindow.PointsToScreenPixelsX((ActiveWindow.VisibleRange.Range("A1").Left) * 96 / 72)
    y2 = (c.y - y1) * 72 / 96 + ActiveWindow.VisibleRange.Range("A1").Top
    x2 = (c.x - x1) * 72 / 96 + ActiveWindow.VisibleRange.Range("A1").Left

    getExcelCusorPos.x = CSng(x2) / (ActiveWindow.Zoom / 100)
    getExcelCusorPos.y = CSng(y2) / (ActiveWindow.Zoom / 100)
    
End Function

Sub cursor_dash()
' cursor_dash Macro
' Keyboard Shortcut: Ctrl+m

    ActiveSheet.Shapes.AddConnector(msoConnectorStraight, _
                                    getExcelCusorPos.x, _
                                    getExcelCusorPos.y - 20, _
                                    getExcelCusorPos.x, _
                                    getExcelCusorPos.y + 100).Select
    
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .DashStyle = msoLineDash
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.5
        .Transparency = 0
    End With
    
End Sub

回路信号波形を描画する際に使っています

以下のページの点線縦線を描画する時に使ってます。

コメント