新编辑版本
请看以下代码。核心思路是使用RangeFromPoint，它返回在指定屏幕坐标对应位置的Shape或Range对象。
逻辑步骤如下：
1) 获取点击位置和屏幕尺寸（以像素为单位）。
2) 获取可见范围内属于不同行/列的前两个单元格，并获取它们的“Excel”位置以及它们的像素位置。
3) 计算“Excel单位”和像素之间的关系。
4) 扫描工作表中的所有形状，获取它们的Excel位置并计算它们的像素位置。
虽然有点冗长（如果删除写入变量到工作表的所有行，则不会太长），但我认为代码相当直观，无需将形状定位到单元格上或检查缩放或类似内容。您可以在工作表中拥有许多形状，并将代码分配给它们中的所有形状。
唯一的要求是可见窗口左上角的四个单元格不能被形状覆盖。
下面的代码是将不同的变量写入表格，仅为了清晰明了。
Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINT) As Long
Private Type POINT
x As Long
y As Long
End Type
Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal index As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Sub GetPixelsFromImageBorder()
Dim pLocation As POINT
Dim objShape As Object
Dim ScreenWidth As Integer
Dim ScreenHeight As Integer
Dim xPix As Integer, yPix As Integer
Dim Cell_1_X As Double, Cell_1_Y As Double
Dim Cell_2_X As Double, Cell_2_Y As Double
Dim Cell_1_Row As Integer, Cell_1_Col As Integer
Dim Cell_2_Row As Integer, Cell_2_Col As Integer
Dim Cell_1_X_Pix As Double, Cell_1_Y_Pix As Double
Dim Cell_2_X_Pix As Double, Cell_2_Y_Pix As Double
Dim Y0 As Double, X0 As Double
Dim SlopeX As Double, SlopeY As Double
Dim flg1 As Boolean, flg2 As Boolean, flg3 As Boolean
Dim WhichWS As Worksheet
Dim w As Window, r As Range, cll As Range
Dim Shp As Shape
Call GetCursorPos(pLocation)
Set WhichWS = Worksheets("Sheet1")
WhichWS.Range("A1:H20").ClearContents
ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
ClickX = pLocation.x
ClickY = pLocation.y
WhichWS.Cells(3, 1) = "Variable"
WhichWS.Cells(3, 1).Font.Bold = True
WhichWS.Cells(3, 2) = "X"
WhichWS.Cells(3, 2).Font.Bold = True
WhichWS.Cells(3, 3) = "Y"
WhichWS.Cells(3, 3).Font.Bold = True
WhichWS.Cells(4, 1) = "Screen (in pixels): "
WhichWS.Cells(4, 2) = ScreenWidth
WhichWS.Cells(4, 3) = ScreenHeight
WhichWS.Cells(5, 1) = "Mouse clicked on (in pixels): "
WhichWS.Cells(5, 2) = ClickX
WhichWS.Cells(5, 3) = ClickY
Set w = ActiveWindow
Set r = w.VisibleRange
i = 1
For Each cll In r.Cells
If i = 1 Then
'get top and right pos (in excel units) of first cell in visible range
'also get row and column of that cell
Cell_1_Y = cll.Top
Cell_1_X = cll.Left
Cell_1_Row = cll.Row
Cell_1_Col = cll.Column
i = i + 1
ElseIf cll.Row > Cell_1_Row And cll.Column > Cell_1_Col Then
'get top and right pos (in excel units) of second cell in visible range
'also get row and column of that cell
Cell_2_Y = cll.Top
Cell_2_X = cll.Left
Cell_2_Row = cll.Row
Cell_2_Col = cll.Column
Exit For
End If
Next
On Error Resume Next
flg1 = False
flg2 = False
flg3 = False
For yPix = 1 To ScreenHeight
For xPix = 1 To ScreenWidth
Set objShape = ActiveWindow.RangeFromPoint(xPix, yPix)
If Not objShape Is Nothing Then
If TypeName(objShape) = "Range" Then
If objShape.Column = Cell_1_Col And objShape.Row = Cell_1_Row Then
'get top and right pos (in pix) of first cell in visible range
If flg2 = False Then
Cell_1_X_Pix = xPix
Cell_1_Y_Pix = yPix
flg2 = True
End If
ElseIf objShape.Column = Cell_2_Col And objShape.Row = Cell_2_Row Then
'get top and right pos (in pix) of second cell in visible range
If flg3 = False Then
Cell_2_X_Pix = xPix
Cell_2_Y_Pix = yPix
flg3 = True
flg1 = True 'exit of outer loop
Exit For 'exit inner loop (this)
End If
End If
End If
End If
Next
If flg1 = True Then Exit For
Next
'Calculate the relation between pixels and 'excel position'
SlopeY = (Cell_2_Y_Pix - Cell_1_Y_Pix) / (Cell_2_Y - Cell_1_Y)
Y0 = Cell_1_Y_Pix - SlopeY * Cell_1_Y
SlopeX = (Cell_2_X_Pix - Cell_1_X_Pix) / (Cell_2_X - Cell_1_X)
X0 = Cell_1_X_Pix - SlopeX * Cell_1_X
'print some variables in sheet
WhichWS.Cells(6, 1) = "Variable"
WhichWS.Cells(6, 1).Font.Bold = True
WhichWS.Cells(6, 2) = "X Pos (excel units)"
WhichWS.Cells(6, 2).Font.Bold = True
WhichWS.Cells(6, 3) = "Y Pos (excel units)"
WhichWS.Cells(6, 3).Font.Bold = True
WhichWS.Cells(6, 4) = "X Pos (pixels)"
WhichWS.Cells(6, 4).Font.Bold = True
WhichWS.Cells(6, 5) = "Y Pos (pixels)"
WhichWS.Cells(6, 5).Font.Bold = True
WhichWS.Cells(6, 6) = "X Dist. from click (pixels)"
WhichWS.Cells(6, 6).Font.Bold = True
WhichWS.Cells(6, 7) = "Y Dist. from click (pixels)"
WhichWS.Cells(6, 7).Font.Bold = True
i = 7
For Each Shp In WhichWS.Shapes
WhichWS.Cells(i, 1) = Shp.Name
WhichWS.Cells(i, 2) = Shp.Left
WhichWS.Cells(i, 3) = Shp.Top
PosInPixX = X0 + Shp.Left * SlopeX
PosInPixY = Y0 + Shp.Top * SlopeY
DistFromClickX = ClickX - PosInPixX
DistFromClickY = ClickY - PosInPixY
WhichWS.Cells(i, 4) = Round(PosInPixX, 2)
WhichWS.Cells(i, 5) = Round(PosInPixY, 2)
WhichWS.Cells(i, 6) = DistFromClickX
WhichWS.Cells(i, 7) = DistFromClickY
i = i + 1
Next Shp
End Sub
