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
回路信号波形を描画する際に使っています
以下のページの点線縦線を描画する時に使ってます。



コメント