Icône de la ressource

placer un userform en lieu et place d'un range 1.0

pour placer un userform au niveau d'une cellule il y plusieurs choses a prendre en compte

  1. la position de l'application
  2. les scrolls vertical et horizontal
  3. les ligne éventuellement figées qui faussent les calculs
  4. le fractionnement de fenêtre qui faussent également les calculs
  5. le freezepane et donc quel pane de l'activewindow qui faussent également les calculs
  6. la version de l'application
  7. la version du sytem d'exploitation
  8. etc..etc..
je vous propose donc une petite sub a mettre dans votre userform
cette sub va prendre en compte l’état de l'affichage de votre application excel en toute circonstances
VB:
Option Explicit



Public Sub placementRange(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 Sub


        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)


    With Me: .Left = L1: .Top = T1: End With

End Sub
et un petit exemple d'appel de l'userform
VB:
Option Explicit
Sub test()
'option Left
'2 ='a droite de la cellule
'1=au milieu du width  de la cellule
'0=la cellule est centré par raport a l'usf
'option Top
'2= en dessous la cellule
'1=milieu du height de la cellule
'0= au top de la cellule

    With UF1
        .placementRange Cells(24, 8), 2, 0    ' a droite et au top cellule
        .Show
    End With
End Sub

je joins un petit fichier à télécharger en exemple avec 3 feuilles ayant été fractionnées, ligne figé ,freezepane
il suffit de cliquer droit sur une cellule pour afficher le userform
Auteur
patricktoulon
Version
1.0