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の座標に変換
- GetCursorPosでWindows座標を取得
- ActiveWindow.VisibleRange.Range(“A1”)でExcelシートの左上の座標をPointで取得して、Pixelでのシートの左上の座標を得る。
- Excelのシートの左上の座標+シート上でのPointでの座標でマウスポインタの位置を取得。
- シートの拡大率により調整
式を見たら、結局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
回路信号波形を描画する際に使っています
以下のページの点線縦線を描画する時に使ってます。
コメント