シェイプ/オブジェクトの背面にあるセルを選択するにはどうすればいいですか？

Question

私ははるかに岩場の状況で戻ってきました。
私は誰もがそれを選択できるということを意味する「クリックスルー」という形を作る必要があり、その背面のセルを選択することができます。
だから私は右のセルを返し、その関数の下に書いた

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は、ActiveWindow.PointsToScreenPixelsXとActiveWindow.PointsToScreenPixelsYを使用して、使用可能な画面の最初のセルの点を画面上のX、Y座標に変換するX、Y座標を取得する関数です。

0.75はピクセルとポイント（オフィス）間の変換レートとしての通常のconst使用です。

すべてが、私はその瞬間からパネル（スプリット行/スプリット列） を凍結してテストするまで、すべての近くのセルにつながる、なかれ間違った形状をクリックしてください...

誰が何を指摘することができ非常にうまく機能します間違っている ？

Answer 1

非常に詳細なテストの後、スケールとDPI、 私はズームモード25 = 0の作業しか考え出しませんでした。 はここで画面X Y上のセルを決定するための最終的なコードであるあなたは、マウスの後ろに及ぶかを知りたいときに、いつでものために

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 

座標、関数を呼び出し、それが正確に返してマウスのポインタの位置の範囲でしょう。

誰もがそれが役に立つと私に投票することを願っています。 良い一日を;）