XL 2016 Position userform dans coin supérieur gauche de cellule 2016 et+

[Nicolas JACQUIN]

Bonjours tout le monde,

Je me permets de ressortir un sujet qui revient assez souvent mais sans vraiment coller pour chacun.
Le placement d'un userform dans le coin supérieur gauche d'une cellule sélectée.

Depuis 2017, avec Patrick on a travaillé sur le sujet un bon moment sans réel succès selon les configurations,
avec souvent une erreur de -5 au left en rapport avec le cadre de l'userform.

Pour ma part, fonctionne sur:

- Excel 2016, 2019, 2021 32 bits sous W10 64bits
- Mode fenêtre ou pleine écran
- Avec ou sans Zoom
- Colonne + ou - réduite

Je vous laisse donc juger.

Voici déjà une fonction,

Function PositionForm(FORM As Object, rng As Range)
With CreateObject("WScript.Shell"): Ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
With FORM: bord = ((.InsideWidth - .Width) / 2) + 1: End With
    With ActiveWindow
        Zom = .Zoom / 100
        lleft = .PointsToScreenPixelsX(rng.Left * Ppx * Zom) / Ppx + bord
        ttop = .PointsToScreenPixelsY(rng.Top * Ppx * Zom) / Ppx
        Hheight = (rng.Height * Ppx) / Ppx * Zom - bord
        Wwidth = (rng.Width * Ppx) / Ppx * Zom - bord * 2
    End With
PositionForm = Array(lleft, ttop, Hheight, Wwidth)
End Function

Sub placement_form1()
    R = PositionForm(UserForm1, ActiveCell)
    With UserForm1: .Show 0: .Left = R(0): .Top = R(1): End With
End Sub

Sub placement_form2()
    R = PositionForm(UserForm1, Range("F17"))
    With UserForm1: .Show 0: .Left = R(0): .Top = R(1): End With
End Sub

Sub placement_form3()
    R = PositionForm(UserForm1, Range("I9:N25"))
    With UserForm1: .Show 0: .Left = R(0): .Top = R(1): .Height = R(2): .Width = R(3): End With
End Sub

Sub placement_form4()
    R = PositionForm(UserForm1, Range("C4:I20"))
    With UserForm1: .Show 0: .Left = R(0): .Top = R(1): .Height = R(2): .Width = R(3): End With
End Sub

Sub placement_form5()
    R = PositionForm(UserForm1, Range("N4:P31"))
    With UserForm1: .Show 0: .Left = R(0): .Top = R(1): .Height = R(2): .Width = R(3): End With
End Sub

Et une Sub,

Sub Placement_form6()
With CreateObject("WScript.Shell"): Ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    With UserForm1
        bord = ((.InsideWidth - .Width) / 2) + 1
            With ActiveWindow
                Zom = .Zoom / 100
                lleft = .PointsToScreenPixelsX(ActiveCell.Left * Ppx * Zom) / Ppx + bord
                ttop = .PointsToScreenPixelsY(ActiveCell.Top * Ppx * Zom) / Ppx
            End With
        .Show 0
        .Left = lleft
        .Top = ttop
    End With
End Sub

Donc si ça fonctionne chez vous, n'hésitez pas à laisser votre configuration, ça permettra de voir.
Merci à tous.

Nicolas

 

[Dudu2]

Si je peux me permettre 2 remarques:
- Ça ne s'applique que si les Panes ne sont pas figées et tu n'as pas spécifiquement testé cette situation (ActiveWindow.FreezePanes = False).
Alors effectivement la recherche dans le Visible ne trouvera un autre Pane que si les Panes ne sont pas figés.
- Cette recherche supplémentaire cherche donc dans le Visible, et si l'objet est visible dans plusieurs Panes, c'est le premier qui gagne si j'ai bien compris.

En fait, lorsque les Panes ne sont pas figés, le challenge serait de déterminer tous les Panes (4 potentielement) dans lesquels se trouve l'objet, visible ou pas (2 listes), en fonction des Pane(x).ScrollRow et ScrollColumn.
Ça poserait un sacré problème de choix pour le positionnement d'un UserForm sur la liste des visibles.

 

[patricktoulon]

le but c'est pas de faire joli
mais d'expliquer pourquoi il est utile selon le besoins d'utiliser une recherche intersect plutôt que la pane originale
en fait c'est tout simplement pour m'éviter de faire des calculs prise de tête

 

[patricktoulon]

re
oui je sais si c'est figer le trait de séparation fait le même que la bordure donc pas de soucis
j'aurais pu le montrer aussi en effet

 

[patricktoulon]

re

En fait, lorsque les Panes ne sont pas figés, le challenge serait de déterminer tous les Panes (4 potentielement) dans lesquels l'objet se trouve l'objet, visible ou pas, en fonction des Pane(x).ScrollRow et ScrollColumn.

et oui c'est là ou je voulais en venir en parlant de calculs prise de tête
et entre parenthèses c'est ce que fait déjà ma getpane
puisque la détection se fait d'abords par le control du left et top par rapport au splitrow et splitcolumn

par contre pour une détection multi pane c'est simple
for i= 1 to .panes.count
if not intersect( .panes(i).visiblerange,obj) is nothing then msgbox "détecté en panes(" & i &")"
next

 

[Dudu2]

Ok, alors peut-être est-il plus sage de toujours garder le Pane d'origine, c'est à dire ton 1er code ?
Qu'est-ce que t'en penses ?

 

[patricktoulon]

non ça dépend si tu veux alourdir le code d'une série de calcul pou ajuster

alors qu'en changeant de panes(celle ou est visible l'object) le pointstoscreenpixels suffit

 

[Dudu2]

Ton idée d'aller chercher dans les VisibleRange des Panes et intéressante pour le cas les Panes ne sont pas figées. En l'utilisant, voilà ce que je te propose:
1 - Déterminer le Pane d'origine de l'objet.
2 - S'il n'y est pas visible, à chercher un autre Pane où il y serait éventuellement visible.

Ça donne la priorité au Pane d'origine (même si l'objet est visible dans plusieurs Panes) et s'il n'y est pas visible on va chercher le 1er Pane où il est visible.

'-----------------------------
'Pane of an ActiveSheet Object
'-----------------------------
Private Function ObjectPane(Object As Object) As Pane
    Dim Rng As Range, PaneIndex%, i%, pr%, pc%
  
    'ActiveSheet is not the Object Parent
    If Not ActiveSheet Is Object.Parent Then Exit Function
  
    With ActiveWindow
        If TypeOf Object Is Range Then Set Rng = Object Else Set Rng = Object.TopLeftCell
        If .SplitRow = 0 Then pr = 1 Else If Rng.Row <= .SplitRow Then pr = 2 Else pr = 3
        If .SplitColumn = 0 Then pc = 1 Else If Rng.Column <= .SplitColumn Then pc = 4 Else pc = 5
      
        'Original Pane index detection
        Select Case pr * pc
            Case 1, 2, 4, 8: PaneIndex = 1
            Case 3, 5, 10: PaneIndex = 2
            Case 12: PaneIndex = 3
            Case 15: PaneIndex = 4
        End Select
      
        'Panes are not frozen
        If Not .FreezePanes Then
            'Object not visible in its original Pane
            If Intersect(.Panes(PaneIndex).VisibleRange, Rng) Is Nothing Then
                'Check if it is visible in other Panes
                For i = 1 To .Panes.Count
                    If Not Intersect(.Panes(i).VisibleRange, Rng) Is Nothing Then Exit For
                Next i
                'Found as visible in another Pane
                If i <= .Panes.Count Then PaneIndex = i
            End If
        End If
      
        'Return value
        Set ObjectPane = .Panes(PaneIndex)
    End With
End Function

 

[Dudu2]

Ce qui donne ça:

 

[patricktoulon]

re
ok pour le if not freezepane
re oui par rapport a ta capture c'est ce que donne mon truc pour les fractionnés non gelés
en effet le if not freezepane me permet de ne pas changer de pane
sauf que si je scroll la 4 donc on vois plus l'object et que par conséquent on la Vera pas en haut non plus il faudrait mettre le getpan a nothing
ca n'a pas de sens de placer un userform sur un object que l'on voit pas même si le résultat est juste
d'ou ma réflexion sur l'utilité même de la fonction getpane dans le cadre de l'affichage du userform sur cell

entendons nous bien ce n'est pas tes calculs et méthodes ou les miennes que je remet en cause et discute là mais l'utilité même de la fonction
maintenant si on cumulait la fonction getpane avec delle de placement peut être

 

[Nicolas JACQUIN]

Ton idée d'aller chercher dans les VisibleRange des Panes et intéressante pour le cas les Panes ne sont pas figées. En l'utilisant, voilà ce que je te propose:
1 - Déterminer le Pane d'origine de l'objet.
2 - S'il n'y est pas visible, à chercher un autre Pane où il y serait éventuellement visible.

Ça donne la priorité au Pane d'origine (même si l'objet est visible dans plusieurs Panes) et s'il n'y est pas visible on va chercher le 1er Pane où il est visible.

'-----------------------------
'Pane of an ActiveSheet Object
'-----------------------------
Private Function ObjectPane(Object As Object) As Pane
    Dim Rng As Range, PaneIndex%, i%, pr%, pc%
 
    'ActiveSheet is not the Object Parent
    If Not ActiveSheet Is Object.Parent Then Exit Function
 
    With ActiveWindow
        If TypeOf Object Is Range Then Set Rng = Object Else Set Rng = Object.TopLeftCell
        If .SplitRow = 0 Then pr = 1 Else If Rng.Row <= .SplitRow Then pr = 2 Else pr = 3
        If .SplitColumn = 0 Then pc = 1 Else If Rng.Column <= .SplitColumn Then pc = 4 Else pc = 5
     
        'Original Pane index detection
        Select Case pr * pc
            Case 1, 2, 4, 8: PaneIndex = 1
            Case 3, 5, 10: PaneIndex = 2
            Case 12: PaneIndex = 3
            Case 15: PaneIndex = 4
        End Select
     
        'Panes are not frozen
        If Not .FreezePanes Then
            'Object not visible in its original Pane
            If Intersect(.Panes(PaneIndex).VisibleRange, Rng) Is Nothing Then
                'Check if it is visible in other Panes
                For i = 1 To .Panes.Count
                    If Not Intersect(.Panes(i).VisibleRange, Rng) Is Nothing Then Exit For
                Next i
                'Found as visible in another Pane
                If i <= .Panes.Count Then PaneIndex = i
            End If
        End If
     
        'Return value
        Set ObjectPane = .Panes(PaneIndex)
    End With
End Function

Bonjour,
Question con, comment lancer la fonction, pour les nuls

 

[Dudu2]

Après, lorsque l'objet est visible dans plusieurs Panes, le choix du Pane d'origine est purement arbitraire et ne vaut pas davantage qu'un choix autre. Mais faut bien un critère dans ce cas.

 

[Dudu2]

Bonjour @Nico_J,
Cette fonction permet de récupérer le Pane d'un objet (Range, Shape, ...) de la feuille active.
Et le Pane sert uniquement à exécuter la bon PointsToScreenPixelsX ou Y(WorksheetObject) qui sont des fonction Excel qui tiennent compte des bordures (entêtes de lignes et de colonnes), du décalage du Pane par rapport à l'écran en X et en Y), et même du Zoom ! Sans elles on ne peut rien faire !

Donc au départ tu fais par exemple:

Dim Pan as Pane
Set Pan = ObjectPane(<MonRange ou MaShape>)

Et ensuite tu connais la position Pixels de <MonRange ou MaShape> en faisant

Dim PosLeftObjectPixels as long
Dim PosTopObjectPixels as long

PosLeftObjectPixels = Pan.PointsToScreenPixelsX(<MonRange ou MaShape>.Left)
PosTopObjectPixels = Pan.PointsToScreenPixelsY(<MonRange ou MaShape>.Top)

Si tu dois positionner un UserForm, ne reste plus qu'à transformer les Pixels en Points avec la méthode que tu préfères (perso j'utilise les API) par exemple l'accès au registre ou les API via ExcelMacro4 de @patricktoulon (voir plus haut).

UserForm.Left = ConvertPixelsToPoints(PosLeftObjectPixels)
UserForm.Top= ConvertPixelsToPoints(PosTopObjectPixels)

 

[patricktoulon]

pour moi elle me convient comme ça

Function GetPaneOfObject2(obj As Object) As Pane
    Dim X&, I&, Plage As Range, ObjX As Object
    If TypeOf obj Is Range Then Set ObjX = obj Else Set ObjX = obj.TopLeftCell
    With ActiveWindow
        If .SplitColumn > 0 Then If obj.Left > Cells(1, .SplitColumn).Offset(, 1).Left Then X = 2 Else X = 1
        If .SplitRow > 0 Then If obj.Top > Cells(.SplitRow, 1).Offset(1).Top Then X = X + 1
        If .Panes.Count = 4 Then
            If obj.Top > Cells(.SplitRow, 1).Offset(1).Top Then X = X + 1
        End If

        If Not .FreezePanes Then
            If Intersect(.Panes(X).VisibleRange, ObjX) Is Nothing Then
                For I = 1 To .Panes.Count
                    Set Plage = .Panes(I).VisibleRange
                    If Not Intersect(Plage, ObjX) Is Nothing Then Set GetPaneOfObject2 = .Panes(I): Exit Function
                Next
            End If
        End If
        Set GetPaneOfObject2 = .Panes(X)
    End With
End Function

après pour être honnête justement ,sans le if not freezpane sur fractionné ou figé j'ai le même résultat
sauf que la pane considérée n'est pas la même
mais l'userform est affiché correctement

d’où mon questionnement sur l'intérêt même de la fonction plutôt qu'un test intersect sur les panes

 

[Dudu2]

d’où mon questionnement sur l'intérêt même de la fonction plutôt qu'un test intersect sur les panes

Ça dépend si tu veux que l'objet soit toujours visible ou pas.
Si tu veux qu'il soit toujours visible, alors l'Intersect suffit en effet, que les Panes soient figés ou pas.

Mais on peut vouloir les coordonnées d'un objet non visible pour une raison ou une autre.
Par exemple positionner un UserForm avec décalage par rapport à cet objet invisible.
C'est pour ça que dans ma fonction d'origine (pas la dernière ici) , j'avais un paramètre Visible pour préciser ce qu'on voulait.

 

[Nicolas JACQUIN]

Bonjour @Nico_J,
Cette fonction permet de récupérer le Pane d'un objet (Range, Shape, ...) de la feuille active.
Et le Pane sert uniquement à exécuter la bon PointsToScreenPixelsX ou Y(WorksheetObject) qui sont des fonction Excel qui tiennent compte des bordures (entêtes de lignes et de colonnes), du décalage du Pane par rapport à l'écran en X et en Y), et même du Zoom ! Sans elles on ne peut rien faire !

Donc au départ tu fais par exemple:

Dim Pan as Pane
Set Pan = ObjectPane(<MonRange ou MaShape>)

Et ensuite tu connais la position Pixels de <MonRange ou MaShape> en faisant

Dim PosLeftObjectPixels as long
Dim PosTopObjectPixels as long

PosLeftObjectPixels = Pan.PointsToScreenPixelsX(<MonRange ou MaShape>.Left)
PosTopObjectPixels = Pan.PointsToScreenPixelsY(<MonRange ou MaShape>.Top)

Si tu dois positionner un UserForm, ne reste plus qu'à transformer les Pixels en Points avec la méthode que tu préfères (perso j'utilise les API) par exemple l'accès au registre ou les API via ExcelMacro4 de @patricktoulon (voir plus haut).

UserForm.Left = ConvertPixelsToPoints(PosLeftObjectPixels)
UserForm.Top= ConvertPixelsToPoints(PosTopObjectPixels)

Escuse-moi Dudu2, tu n'aurai pas un petit fichier exemple que j'y réfléchisse, parce que là