Option Explicit
Function GetScreenLeftTopCell(obj As Range, Optional posLeft As Long = 0, Optional posTop As Long = 0)
Dim Z#, EcX#, L1#, T1#, C#, R#, Vr As Range, Hx#, Wx#, Ok As Boolean, Op&, PtoPx#, I&
With ActiveWindow
PtoPx = (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / 72 'coeff point to pixel
Op = Int(Val(Mid(Application.OperatingSystem, InStrRev(Application.OperatingSystem, " ") + 1))) 'number version system
'exit si la cellule injecté n'est pas vible a l'ecran
For I = 1 To .Panes.Count
If Not Intersect(.Panes(I).VisibleRange, obj) Is Nothing Then Ok = True
Next
If Ok = False Then Beep: MsgBox " cette cellule n'est pas visible a l'ecran": Exit Function
Z = (ActiveWindow.Zoom / 100): Set Vr = .VisibleRange 'Coeff zoom , rangevisible partie mobile
EcX = 4 And Op = 6 And Int(Val(Application.Version)) < 16 'ecart cadre grosse bordures 2007 et Windows 7
'placement partie mobile
L1 = (.ActivePane.PointsToScreenPixelsX(Int(obj.Left)) / PtoPx) * Z + EcX
T1 = .ActivePane.PointsToScreenPixelsY(Int(obj.Top)) / PtoPx * Z + EcX
'limite splitrow et splitcolumn
With .Panes(1).VisibleRange: C = .Cells(.Cells.Count).Column: R = .Cells(.Cells.Count).Row: End With
If .SplitRow > 0 Then 'placement si dans le splitrow
If obj.Row < R + 1 And .ScrollRow > R Then T1 = ((.ActivePane.PointsToScreenPixelsY(Vr.Cells(1).Top) / PtoPx) * Z) - (Range(obj, Cells(R, 1)).Height * Z) + EcX
End If
If .SplitColumn > 0 Then 'placement si dans le splitcolumn
If obj.Column < C + 1 And .ScrollColumn > C Then L1 = ((.ActivePane.PointsToScreenPixelsX(Vr.Cells(1).Left) / PtoPx) * Z) - (Range(obj, Cells(1, C)).Width * Z) + EcX
End If
End With
'option de placement :
Wx = (obj.Width / 2) * Z
Hx = (obj.Height / 2) * Z
L1 = L1 + (Wx * posLeft)
T1 = T1 + (Hx * posTop)
GetScreenLeftTopCell = Array(L1, T1)
End Function