Question

我回来时情况更加艰难我需要制作一个形状＆＃34;点击通过＆＃34;这意味着没有人可以选择它，我可以选择背面的单元格所以我写下了返回正确单元格的函数

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 coor，它使用ActiveWindow.PointsToScreenPixelsX和ActiveWindow.PointsToScreenPixelsY内置函数将可用屏幕的第一个单元格的点转换为X，Y coor在屏幕上。

0.75是正常的常量，用作像素和点（办公室）之间的转换率。

一切都很顺利，直到我用冷冻面板测试（分割行/分割柱）从那一刻起，每次点击形状总是错误的，导致附近的细胞...

有谁可以指出出了什么问题？

Answer 1

嗯，经过非常详细的测试，比例和DPI，我想出只有zoom mod 25 = 0 work。以下是确定屏幕X Y坐标上的Cell的最终代码

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

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

希望每个人都能发现它有用并投票给我。祝你有美好的一天;）

如何选择形状/对象背面的单元格（单击该形状）？

1 个答案: