How do I get the coordinates of the cursor position relative to a rectangle (the one I use to call the macro)? Here what I got this far:
First: I use the function:
Declare PtrSafe Function GetCursorPos Lib "user32" (Point As POINTAPI) As Long Type POINTAPI X As Long Y As Long End Type
to get the coordinates of the cursor on the screen. Those values are returned by:
Point.X 'pixels to the left of the screen Point.Y 'pixels to the top of the screen
Second: I created a rectangle like this:
and set the following macro to it:
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
On my mind, when I did this, I was positive I was getting the coordinates of the cursor inside the green rectangle. However, when I clicked on the black spot on the next image:
the coordinates that my plan returned weren't the expected near 0 coordinates I thought:
Then I realized that the
GetCursorPos were returning the position of the cursor relative to the screen while the
rectang.Top commands on my script were returning the position of the rectangle relative to the spreadsheet. So, the lines
Point.X - rectang.Left and
Point.X - rectang.Left couldn't possibly be right.
Any ideas how I could get the correct coordinates? i.e How can I get the right coordinates near 0 by clicking on the black spot? Any help will be very appreciated. And, as always, thank you all in advance.
As I told, I got what I want after exploring an idea gived to me by @Luuklag (by aligning the rectangle with a range of cells).
First I put the next code on a different module (just for a well organized code matter):
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
After this, I set the rectangle with the next macro:
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
The previous macro places and adjusts the rectangle
SH03G13BACK to the
.Cells(2, 2), .Cells(13, 10) range. Once this is done, the
Point.X - rc.Left and
Point.Y - rc.Top commands gave me the exact coordinates inside the rectangle (and relative to it), regardless the maximized/minimized state of the excel window, the zoom value, the size/contents of the excel command ribbon or the size/resolution of the screen itself. It's perfect:
I realize this is a little cheating (I know that the
GetRangeRect subroutine gives the coordinates relative to the
.Cells(2, 2) position. However, for this matter, the trick works like a charm.