XL 2016 VBA Challenge - Positionner un UserForm sur Objet feuille dans une feuille fractionnée

Sub a()
    With ActiveWindow
        .Zoom = 100
        MsgBox (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / 72    'coeff point to pixel
        .Zoom = 75
        MsgBox (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / 72    'coeff point to pixel
        .Zoom = 150
        MsgBox (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / 72    'coeff point to pixel
        .Zoom = 100
    End With
End Sub

    Dim Coeff_PointToPixel As Double
    Dim Coeff_PixelToPoint As Double
    Dim Zoom As Double
  
    With ActiveWindow
        'Facteur Zoom
        Zoom = .Zoom / 100

        'Coefficients Pixels <-> Points équivalents API
        Coeff_PointToPixel = (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / Zoom / 72
        Coeff_PixelToPoint = 1 / Coeff_PointToPixel
      
        Left = (.ActivePane.PointsToScreenPixelsX(0) * Coeff_PixelToPoint) + (SheetObject.Left + HorizontalShift + SpecialShift) * Zoom
        Top = (.ActivePane.PointsToScreenPixelsY(0) * Coeff_PixelToPoint) + (SheetObject.Top + VerticalShift + SpecialShift) * Zoom
    End With

Sub Test()
    MsgBox "PointToPixel = " & PointsToPixels & vbCrLf & _
           "PixelToPoint = " & PixelsToPoints
End Sub

'------------------------------------
'Conversion Pixels to Points sans API
'------------------------------------
Function PixelsToPoints(Optional ByVal Pixels As Double = 1) As Double
    Dim Ratio_PointToPixel As Double
    Dim Ratio_PixelToPoint As Double
    Dim InchesToPoints As Integer
    Dim Zoom As Double
   
    With ActiveWindow
        'Facteur Zoom
        Zoom = .Zoom / 100
        InchesToPoints = Application.InchesToPoints(1)
       
        'Coefficients Pixels <-> Points équivalents API
        Ratio_PointToPixel = (.ActivePane.PointsToScreenPixelsX(InchesToPoints) - .ActivePane.PointsToScreenPixelsX(0)) / Zoom / InchesToPoints
        Ratio_PixelToPoint = 1 / Ratio_PointToPixel
    End With
   
    PixelsToPoints = Pixels * Ratio_PixelToPoint
End Function

'------------------------------------
'Conversion Points to Pixels sans API
'------------------------------------
Function PointsToPixels(Optional ByVal Points As Double = 1) As Double
    Dim Ratio_PointToPixel As Double
    Dim Ratio_PixelToPoint As Double
    Dim InchesToPoints As Integer
    Dim Zoom As Double
   
    With ActiveWindow
        'Facteur Zoom
        Zoom = .Zoom / 100
        InchesToPoints = Application.InchesToPoints(1)
       
        'Coefficients Pixels <-> Points équivalents API
        Ratio_PointToPixel = (.ActivePane.PointsToScreenPixelsX(InchesToPoints) - .ActivePane.PointsToScreenPixelsX(0)) / Zoom / InchesToPoints
        Ratio_PixelToPoint = 1 / Ratio_PointToPixel
    End With
   
    PointsToPixels = Points * Ratio_PointToPixel
End Function

Public Sub Posit(ByVal Obj As Object, Optional ByVal X As Double, Optional ByVal Y As Double)
Rem. ——— Méthode. Vous pouvez au préalable positionner l'UserForm par rapport à quelque chose.
'     Obj: Ce par rapport à quoi vous voulez le positionner. X et Y indiqueront comment :
'     X: -1: Collé au coté gauche, 0: Centré horizontalement, 1: Collé au coté droit.
'     Y: -1: Collé au bord supérieur, 0: Centré verticalement, 1: Collé juste en dessous.
'     Mais si la valeur absolue de X >= 1, Y:=0.9 est une valeur conventionnelle demandant
'        à ce que le bord supérieur du calendrier soit aligné sur celui de Obj.
'     D'autres valeurs entraineront un recouvrement partiel ou un certain éloignement.
'     Mais rien ne vous empêche de rectifier encore ensuite la propriété Left ou Top
'     de l'UFmCalend pour ajouter un interstice en points au bord de l'objet. Mais toujours
'        avant le Show, donc avant utilisation de la méthode Saisie.
'     X et Y sont facultatifs et assumés = 0. Il est donc centré sur l'objet Obj si non précisés.
   Dim Lft As Double, Top As Double, Rgt As Double, Bot As Double, U As Object, UInsWidth As Single, _
      UInsHeight As Single, K As Double, Wnw As Window, P As Long, Pan As Pane, Px72 As Long, Trnq As Long
   If TypeOf Obj Is MSForms.Control Then
      Lft = Obj.Left: Top = Obj.Top: Set U = Obj.Parent ' Normalement UserForm, Frame ou Page.
      Do: UInsWidth = U.InsideWidth: UInsHeight = U.InsideHeight ' Le Multipage n'aura pas de dimensions
         If TypeOf U Is MSForms.Page Then Set U = U.Parent ' intérieures, mais le Page n'avait rien d'autre.
         K = (U.Width - UInsWidth) / 2
         Lft = Lft + U.Left + K
         Top = Top + U.Top + U.Height - K - UInsHeight
         If Not (TypeOf U Is MSForms.Frame Or TypeOf U Is MSForms.MultiPage) Then Exit Do
         Set U = U.Parent: Loop
      Rgt = Lft + Obj.Width: Bot = Top + Obj.Height
   Else
      Set Wnw = ActiveWindow: Set Pan = Wnw.ActivePane
      If Intersect(Pan.VisibleRange, Obj) Is Nothing Then
         For P = 1 To Wnw.Panes.Count: Set Pan = Wnw.Panes(P)
            If Not Intersect(Pan.VisibleRange, Obj) Is Nothing Then Exit For
            Next P
         If P > Wnw.Panes.Count Then Exit Sub ' Abandon si la plage n'est visible nulle part.
         End If
      Px72 = GetDeviceCaps(GetDC(0), 88) ' Nombre de pixels pour 72 points.
      Lft = Obj.Left: Trnq = Int(Lft / 3) * 3
      Lft = Pan.PointsToScreenPixelsX(Trnq) * 72 / Px72 + (Lft - Trnq)
      Px72 = GetDeviceCaps(GetDC(0), 90) ' Nombre de pixels pour 72 points.
      Top = Obj.Top: Trnq = Int(Top / 3) * 3
      Top = Pan.PointsToScreenPixelsY(Trnq) * 72 / Px72 + (Top - Trnq)
      K = Wnw.Zoom / 100: Rgt = Lft + Obj.Width * K: Bot = Top + Obj.Height * K
      End If
   Me.Left = (X * (Rgt - Lft + Me.Width + 6) + Lft + Rgt - Me.Width - 6) / 2 + 3
   If Abs(X) >= 1 And Y = 0.9 Then
      Me.Top = Top
   ElseIf Abs(X) >= 1 And Y = -0.9 Then
      Me.Top = Bot - Me.Height
   Else
      Me.Top = (Y * (Bot - Top + Me.Height + 6) + Top + Bot - Me.Height - 6) / 2 + 3
      End If
   End Sub