如何选择形状/对象背面的单元格(单击该形状)? [英] How to select cell on the back of a shape/object (click through that shape)?

问题描述

我回来时遇到的困难要多得多.
我需要制作一个单击"形状，这意味着没有人可以选择它，并且可以选择它背面的单元格.
所以我写了下面的函数，返回正确的单元格

I came back with a far more rocky situation.
I need to make a shape "click through" which mean noone can select it, and I can select the cell on the back of it.
So i wrote below function that return the right cell

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调用获取鼠标位置的函数.

Explain: MouseX, mouseY are functions getting mouse position from API call.

Getcelllocation是用于通过使用ActiveWindow.PointsToScreenPixelsX和ActiveWindow.PointsToScreenPixelsY内置函数来将屏幕上的X，Y坐标转换为屏幕上的X，Y坐标的函数，以获取屏幕上的X，Y坐标.

Getcelllocation is a function use to get the X, Y coor on screen which using ActiveWindow.PointsToScreenPixelsX and ActiveWindow.PointsToScreenPixelsY build-in function to convert points of 1st cell of usable screen to X, Y coor on screen.

0.75是正常const，用作像素和点(办公室)之间的转换率.

0.75 is a normal const use as convert rate between pixel and point (office).

一切正常，直到我测试了冻结面板(分割行/分割列)从那一刻起，每次点击形状总是错误，会导致附近的单元格...

everything work very well until I test with freezing panel (split row/split column) from that moment, every click on a shape alway wrong, lead to nearby cell...

任何人都可以指出出什么问题了吗?

Can anyone point out what is wrong ?

推荐答案

好吧，在非常详细地测试了比例和DPI之后，我发现只有zoom mod 25 = 0可以工作.这是确定屏幕上的单元格X Y坐标的最终代码

Well, after very detail test the scale and DPI, I figured out only zoom mod 25 = 0 work. Here is the final code for determine Cell on Screen X Y coordinates

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

任何时候，如果您想知道鼠标后面的范围，请调用该函数，它将在您的鼠标指针处精确返回范围.

For anytime, when you want to know which range behind your mouse, call the function, it'll return exactly range at your mouse's pointer.

希望每个人都能找到它并为我投票.祝你有美好的一天;)

Hope everyone could find it usefull and vote for me. Have nice day ;)

这篇关于如何选择形状/对象背面的单元格(单击该形状)?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！