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

 

[Nicolas JACQUIN]

Bonjour la liste,

Une petit commentaire histoire de...
Les API sont formelles, les marges extérieures (Windows 10 64bits / Office 2016 64 bits) d'un UserForm sont:
Top = 0
Left, Right, Bottom = 4.8 pt (chez moi).
Et le positionnement sur un Range le confirme. Pas de problème à ce niveau encore que, au niveau du Top, il manque un chouia (environ 1/2 point) qu'on retrouve en débordement en bas.
Regarde la pièce jointe 1194316

Comment se manifestent ces marges ?
Par un grisé, certes très léger, mais néanmoins visible.
Or que remarque-t-on en examinant les bords du UserForm ? Qu'il y a aussi un grisé au niveau du Top !

Il y a donc un bug ou une anomalie dans les UserForms Excel Windows sur la marge supérieure.
Sur MAC, la marge supérieure n'est pas nulle et égale les autres marges latérales.

En même temps si je peux avoir cette exemple là aussi, en te remerciant

 

[patricktoulon]

re a la réflexion c'est pas bon if freezpane
je viens de tester en essayant d'avoir la J12 dans une seule pane (j'ai essayé les 4)
si l'original est scrollée ca fausse les calculs

par exemple ici la j12 est apparente seulement en pane 3

maintenant en enlevant le if freezepanes

autrement pour placer le userform mieux vaut choisir la pane dans la quelle l'object aparait plutot que l'originale
donc le test freezepane on oublie

 

[Dudu2]

@patricktoulon,
La fonction que j'utilise possède ce paramètre pour indiquer si on veut que l'objet soit visible ou pas.
Je l'ai indiquée en Post #51.
Et en effet, si on veut qu'il soit visible, on cherche dans les Panes le 1er Pane où il est visible sans plus.

 

[patricktoulon]

@patricktoulon,
La fonction que j'utilise possède ce paramètre pour indiquer si on veut que l'objet soit visible ou pas.
Je l'ai indiquée en Post #51.

oui c'est pas le problème
dans mes fonction aussi j'ai un param pour (activepane ou panne détectée ou autre)
donc freezepanes je le redis on oublie par rapport à ma démo précédente

 

[Dudu2]

@Nico_J,
Voici un fichier de démo de positionnement UserForm qui est issu de cette ressource et simplifiée.
Il n'y a pas de correction des marges via l'API ni de paramètres autres de décalage demandé.

La fonction de positionnement correspond à ce que je t'ai dit précédemment.

Edit: A noter que la détermination du Pane de l'Object (Appel de la fonction ObjectPane avec paramètre Visible = False) n'exige pas que l'Object (dans ce cas l'ActiveCell) soit visible, ce qui peut résulter en un positionnement de UserForm en dehors de l'écran.

 

[Dudu2]

donc freezepanes je le redis on oublie par rapport à ma démo précédente

Dans le cas où il faut que l'objet soit visible, c'est au choix du développeur selon qu'il veut donner une priorité au Pane original ou pas. Dans la fonction que j'utilise (fichier ci-dessus et ressource), je ne lui en donne aucune et prend le 1er Pane où il est visible, comme toi.

Dans tous les cas cela fonctionnera. Car le Pane original n'a aucun privilège ou défaut par rapport aux autres.
Le preuve est que si la recherche par index de Pane tombe sur lui, ce sera comme s'il tombait sur un autre quelconque.

 

[patricktoulon]

re
à la lumière de tout ces tests
il apparait évident pour éviter des calculs prises de tests qu'il faut choisir la pannes ou l'object est visible
si il n'est pas visible dans sa pane original et cela (j'insiste sur ce point) avec freezepane ou pas

donc ma fonction restera celle ci

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

        If Intersect(.Panes(X).VisibleRange, ObjX) Is Nothing Then
            X = 0
            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
        If X > 0 Then Set GetPaneOfObject2 = .Panes(X)
    End With
End Function

je vous laisse le soin de tester
la feuille "A" vous scrollez et vous mettez la J12 ou vous voulez
si l'object est visible dans sa pane originale se sera la pane originale
si il ne l'ai pas se sera dans celle qui apparait en premier en partant de la 1
si l'object n'est pas visible la pane sera nothing
les feuilles qui suivent c'est des feuilles avec figé ou je fait apparaitre la J12 tantôt en pane (1 ,2 ,3 ,4)
fonctionne bien évidemment avec d'autre object que les cellules

et voilà c'est propre et net

 

[Dudu2]

Il n'y a pas d'ambigüité dans une approche qui paramètre la visibilité.
Soit on exige que l'objet soit visible soit on accepte qu'il ne le soit pas.
- Si on exige qu'il soit visible, on ne peut pas renvoyer un Pane où il n'est pas visible.
- Si on accepte qu'il ne le soit pas, il n'y a pas de raison d'aller renvoyer une Pane ou il est visible sauf à donner une priorité à la visibilité, ce qui n'est pas idiot.

Après chacun voit midi à sa porte. Et on a quoi ? 150 km de décalage sur le soleil devant la Grande Bleue, 5mn en gros.

 

[Dudu2]

- Si on accepte qu'il ne le soit pas, il n'y a pas de raison d'aller renvoyer une Pane ou il est visible sauf à donner une priorité à la visibilité, ce qui n'est pas idiot.

Fort de ces réflexions et discussions productives, faisons ce qui n'est pas idiot finalement .

Voilà ce qu'est le code résultant:

#Const PREFERENCE_VISIBLE = True
'-----------------------------
'Pane of an ActiveSheet Object
'-----------------------------
Function ObjectPane(Object As Object, Optional Visible As Boolean = True) As Pane
    Dim Rng As Range, PaneIndex%, i%, pr%, pc%, PreferenceVisible As Boolean
    
    'ActiveSheet is not the Object Parent
    If Not ActiveSheet Is Object.Parent Then Exit Function
    
    'Object Range
    If TypeOf Object Is Range Then Set Rng = Object Else Set Rng = Object.TopLeftCell
    
    With ActiveWindow
        '----------------------------------------
        'Case 1: the Object can be visible or not
        '----------------------------------------
        If Not Visible Then
            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
            
#If PREFERENCE_VISIBLE Then
            'Object is not visible in its original Pane and Panes are not frozen
            If Intersect(.Panes(PaneIndex).VisibleRange, Rng) Is Nothing _
            And Not .FreezePanes Then PreferenceVisible = True
#End If
        End If
        
        '----------------------------------
        'Case 2: the Object must be visible
        'Case 1B: Case 1 and panes are not frozen and the preference is given to a visible Object if not already visible in its original Pane
        '----------------------------------
        If Visible Or PreferenceVisible Then
            'Check if the Object is visible in the 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 a Pane
            If i <= .Panes.Count Then PaneIndex = i
        End If
        
        'Return value
        If Not PaneIndex = 0 Then
            Visible = (Not Intersect(.Panes(PaneIndex).VisibleRange, Rng) Is Nothing)
            Set ObjectPane = .Panes(PaneIndex)
        End If
    End With
End Function

 

[Dudu2]

En même temps si je peux avoir cette exemple là aussi, en te remerciant

@Nico_J ,
Voici un fichier avec le Module_GetUserFormMarginsPoints et des modules de test qui te permettront , je l'espère, d'y voir plus clair.