Skip to content

Instantly share code, notes, and snippets.

Last active October 5, 2021 13:16
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
What would you like to do?
[Excel][VBA] ドキュメント座標を画面座標に変換

[Excel][VBA] ドキュメント座標を画面座標に変換


  • (0, 0) 以外のドキュメント座標がうまく変換できない
  • ウィンドウ枠の固定をしていたり、マルチディスプレイ環境の場合もうまく変換できない

踊るエクセル@ExcelVBAer さんのご教示により、ドキュメント座標がActiveWindowの.Panes(i).VisibleRange(i=1~.Panes.Count)のどこに属するか調べた上で、当該PaneのPane.PointsToScreenPixelsX()Pane.PointsToScreenPixelsY()を使用すればよいことがわかったので、これを元に汎用プロシージャ:ConvertToScreenCoordinates()を作ってみました。

' Cell(Range)の左上の座標を画面座標に変換(戻り値はCollection)
Set Result = ConvertToScreenCoordinates(Cell.Top, Cell.Left)
Debug.Print "X:" & Result("X") & ", Y:" & Result("Y")


[^1] ドキュメント座標(document coordinates):ワークシートの左上(A1)セルの.Top/.Leftを原点とする座標・ポイント(PPI)単位
[^2] 画面座標(screen coordinates):画面の左上を原点とする座標・ピクセル(DPI)単位


Option Explicit
Function ConvertToScreenCoordinates(DocumentTop, DocumentLeft) As Collection
Dim Result As Collection
Dim PaneIndex As Long, WorkPane As Pane, WorkRange As Range
For PaneIndex = 1 To ActiveWindow.Panes.Count
Set WorkPane = ActiveWindow.Panes(PaneIndex)
Set WorkRange = WorkPane.VisibleRange
If _
((WorkRange.Top <= DocumentTop) And (DocumentTop < WorkRange.Top + WorkRange.Height)) And _
((WorkRange.Left <= DocumentLeft) And (DocumentLeft < WorkRange.Left + WorkRange.Width)) _
Set Result = New Collection
Result.Add WorkPane.PointsToScreenPixelsX(DocumentLeft), Key:="X"
Result.Add WorkPane.PointsToScreenPixelsY(DocumentTop), Key:="Y"
Exit For
End If
Set ConvertToScreenCoordinates = Result
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment