How to select cell on the back of a shape/object (

Question

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

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

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 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 ?

Answer 1

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 ;)