如何select一个形状/对象背面的单元格（单击该形状）？

我回来了，情况更加恶劣。
我需要做一个“点击”的形状，这意味着没有人可以select它，我可以select它的背面单元格。
所以我写下面的函数返回正确的单元格

Function ShapeOnClick() As Excel.Range 'Created by HvSum Dim Rng As Range, DShape As Shape Dim X As Long, Y As Long, Zoom As Byte Zoom = Int(ActiveWindow.Zoom) With ActiveSheet X = 0.75 * (MouseX() - Split(getCellLocation(.Range("A1")), ",")(0)) If ActiveWindow.SplitColumn > 0 Then X = X - .Columns(ActiveWindow.SplitColumn + 1).left Y = 0.75 * (MouseY() - Split(getCellLocation(.Range("A1")), ",")(1)) If ActiveWindow.SplitRow > 0 Then Y = Y - .Rows(ActiveWindow.SplitRow + 1).top x = x / Zoom * 100 y = y / Zoom * 100 Set DShape = .Shapes.AddShape(msoLine, X, Y, 1, 1) End With With DShape .Visible = msoTrue Set Rng = .TopLeftCell .Delete End With Set ShapeOnClick = Rng End Function 

说明：MouseX，mouseY是从API调用获取鼠标位置的函数。

Getcelllocation是一个函数用于获取屏幕上的X，Y坐标，它使用ActiveWindow.PointsToScreenPixelsX和ActiveWindow.PointsToScreenPixelsY内置函数将第一个可用屏幕单元的点转换为X，Y坐标。

0.75是像素和点（办公室）之间的转换速率的常规常量。

一切工作得很好，直到我从那个时候testing与冻结面板（拆分行/拆分列），每一个形状总是点击错误，导致附近的细胞…

任何人都可以指出什么是错的？

Answer 1

那么，经过非常详细的testing规模和DPI，我想出了只有缩放mod 25 = 0工作。 这里是确定屏幕XY坐标上单元格的最终代码

 Function RngFromXY(Optional RelTopleftCell As Range) As Range '#####Design by Hv summer###### 'please link to this thread when you using it on your project, thank you! Dim Rng As Range, DShape As Shape Dim x As Double, y As Double, Zoom As Double Dim TopPanel As Long, LeftPanel As Long Dim TopRelative As Long, LeftRelative As Long Dim BonusLeft As Double, BonusTop As Double Dim mX As Long, mY As Long, Panel As Integer 'Call mouse API to get Coordinates---------------------------- Mouse mX = mXY.x mY = mXY.y '------------------------------------------------------------------------ With ActiveWindow If .Zoom Mod 25 <> 0 Then If .Zoom > 12 Then .Zoom = Round(.Zoom / 25) * 25 Else .Zoom = 25 End If End If Zoom = .Zoom / 100 '--------------------------------------------------- TopPanel = .PointsToScreenPixelsY(0) LeftPanel = .PointsToScreenPixelsX(0) '--------------------------------------------------- Select Case .Panes.count Case 2: Panel = 2 Case 4: Panel = 4 End Select If .SplitColumn > 0 Then BonusLeft = Application.RoundUp(.VisibleRange.Cells(1, 1).Left, 1) * Zoom LeftRelative = .Panes(Panel).PointsToScreenPixelsX(Int(Application.RoundUp(.VisibleRange.Cells(1, 1).Left * Zoom / PPP.x, 0))) End If If .SplitRow > 0 Then BonusTop = Application.RoundUp(.VisibleRange.Cells(1, 1).Top, 1) * Zoom TopRelative = .Panes(Panel).PointsToScreenPixelsY(Int(Application.RoundUp(.VisibleRange.Cells(1, 1).Top * Zoom / PPP.y, 0))) End If '===================================================================================== 'Compare mouse position with left and top relative to known which areas it's in If .SplitRow + .SplitColumn > 0 Then Select Case True Case mX > LeftRelative And mY > TopRelative x = PPP.x * (mX - LeftRelative) + BonusLeft y = PPP.y * (mY - TopRelative) + BonusTop Case mX > LeftRelative x = PPP.x * (mX - LeftRelative) + BonusLeft y = PPP.y * (mY - TopPanel) Case mY > TopRelative x = PPP.x * (mX - LeftPanel) y = PPP.y * (mY - TopRelative) + BonusTop Case Else x = PPP.x * (mX - LeftPanel) y = PPP.y * (mY - TopPanel) End Select Else x = PPP.x * (mX - LeftPanel) y = PPP.y * (mY - TopPanel) End If x = x / Zoom y = y / Zoom End With '===================================================================================== With ActiveSheet Set DShape = .Shapes.AddShape(msoLine, x, y, 0.001, 0.001) End With '===================================================================================== 'Get topleftcell of dummy shape With DShape .Visible = msoTrue Set Rng = .TopLeftCell .Delete End With '--------------------------------------------- 'Return range to function Set RngFromXY = Rng End Function 

在任何时候，当你想知道鼠标后面的范围时，调用该函数，它将返回鼠标指针的范围。

希望大家能够find有用的东西，为我投票。 祝你有美好的一天;）