获取光标在矩形内的位置

Question

如何获取光标位置相对于矩形的坐标(我用来调用宏的那个)？这就是我到目前为止所得到的:

第一:我使用的功能:

Declare PtrSafe Function GetCursorPos Lib "user32" (Point As POINTAPI) As Long
Type POINTAPI
   X As Long
   Y As Long
End Type

获取光标在屏幕上的坐标.这些值由以下方式返回:

Point.X 'pixels to the left of the screen
Point.Y 'pixels to the top of the screen

第二:我创建了一个这样的矩形:

并为其设置以下宏:

Sub SH03G13()
    Dim Point As POINTAPI: GetCursorPos Point
    Dim rectang As Shape: Set rectang = ThisWorkbook.Sheets("Sheet1").Shapes("SH03G13BACK")
    Dim ABCISSA As Long: ABCISSA = Point.X - rectang.Left
    Dim ORDENAD As Long: ORDENAD = Point.Y - rectang.Top

    MsgBox ABCISSA & " " & ORDENAD

End Sub

在我看来,当我这样做时,我很肯定我得到了绿色矩形内光标的坐标.但是,当我点击下一张图片上的黑点时:

我的计划返回的坐标不是我想到的预期的近0坐标:

然后我意识到,GetCursorPos当我的脚本上的rectang.Left和rectang.Top命令返回矩形相对于电子表格的位置时,返回光标相对于屏幕的位置.因此,线Point.X - rectang.Left和Point.X - rectang.Left不可能是正确的.

我有什么想法可以得到正确的坐标？即如何通过点击黑点获得0附近的正确坐标？任何帮助将非常感激.而且,一如既往,提前谢谢大家.

Answer 1

正如我所说，在探索了 @Luuklag 给我的想法（通过将矩形与一系列单元格对齐）后，我得到了我想要的东西。

首先，我将下一个代码放在不同的模块上（只是为了组织良好的代码问题）：

Option Explicit
Type RECT
    Left As Long: Top As Long: Right As Long: Bottom As Long
End Type
Type POINTAPI
    X As Long: Y As Long
End Type
Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Declare PtrSafe Function GetCursorPos Lib "user32" (Point As POINTAPI) As Long
Function ScreenDPI(bVert As Boolean) As Long
    Static lDPI&(1), lDC&
    If lDPI(0) = 0 Then
        lDC = GetDC(0)
        lDPI(0) = GetDeviceCaps(lDC, 88&)
        lDPI(1) = GetDeviceCaps(lDC, 90&)
        lDC = ReleaseDC(0, lDC)
    End If
    ScreenDPI = lDPI(Abs(bVert))
End Function
Function PTtoPX(Points As Single, bVert As Boolean) As Long
    PTtoPX = Points * ScreenDPI(bVert) / 72
End Function
Sub GetRangeRect(ByVal rng As Range, ByRef rc As RECT)
    Dim wnd As Window: Set wnd = rng.Parent.Parent.Windows(1)
    With rng
        rc.Left = PTtoPX(.Left * wnd.Zoom / 100, 0) + wnd.PointsToScreenPixelsX(0)
        rc.Top = PTtoPX(.Top * wnd.Zoom / 100, 1) + wnd.PointsToScreenPixelsY(0)
        rc.Right = PTtoPX(.Width * wnd.Zoom / 100, 0) + rc.Left
        rc.Bottom = PTtoPX(.Height * wnd.Zoom / 100, 1) + rc.Top
    End With
End Sub

之后，我使用下一个宏设置矩形：

Sub SH03G13()
    With ThisWorkbook.Sheets("Sheet1")
        Dim AreaRng As Range: Set AreaRng = .Range(.Cells(2, 2), .Cells(13, 10))
        Dim rectang As Shape: Set rectang = .Shapes("SH03G13BACK")
            rectang.Height = AreaRng.Height
            rectang.Width = AreaRng.Width
            rectang.Top = AreaRng.Top
            rectang.Left = AreaRng.Left
            DoEvents
        Dim Point As POINTAPI: GetCursorPos Point
        Dim rc As RECT: Call GetRangeRect(.Cells(2, 2), rc)
        Dim ABCISSA As Long: ABCISSA = Point.X - rc.Left
        Dim ORDENAD As Long: ORDENAD = Point.Y - rc.Top
    End With

    MsgBox "x: " & ABCISSA & ", y: " & ORDENAD

End Sub

上一个宏将矩形放置并调整SH03G13BACK到.Cells(2, 2), .Cells(13, 10)范围内。完成此操作后，Point.X - rc.Left和Point.Y - rc.Top命令会为我提供矩形内的精确坐标（以及相对于它的坐标），无论 Excel 窗口的最大化/最小化状态、缩放值、Excel 命令功能区的大小/内容或大小/屏幕本身的分辨率。这是完美的：

我意识到这有点作弊（我知道GetRangeRect子例程给出了相对于位置的坐标.Cells(2, 2)。但是，就这一点而言，这个技巧就像一个魅力。