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

 

[TooFatBoy]

Si, le dessin est parfaitement clair, et le texte est compréhensible.

Ce sont les méthodes pour obtenir les valeurs, que je ne comprends pas.
Je crois me rappeler que tu avais déjà essayé de m'expliquer, mais comme on ne parle pas 100 % exactement le même langage "technique", ça me bloque et m'empêche de comprendre.

 

[patricktoulon]

with userform1
.show 0
.move fleche bleue*px to pt , fleche verte *px to pt
end with

 

[TooFatBoy]

Bon ben c'est officiel : suis trop con !
Même ça j'arrive pô à l'comprendre...

Jusqu'à .move ça va, mais c'est après...

 

[patricktoulon]

re
la fonction lapane.poinsToScreenPixelsX
de donne la distance du bord de l’écran gauche à la position left De la grille!!! que tu met dans les parentheses

exemple
ma cellule B1 est à 60 de left dans la grille!!!
pour avoir la distance du (bord de l’écran et non pas du bord de la grille) a ce B1.left en PIXEL je fait
msgbox activewindow.activepane.PointsToScrennPixelsx([B1.left])
pour afficher mon userform a ce left il me convertir en point

autrement dis la fonction me renvoie

1. les 60 en point * pt topx
2. les 21 pixels de la colonne des numéro de ligne
3. la distance entre le bord de l'écran et le bord de l'application
4. le tout en pixel bien sur
5. en plus ce qui a de bien c'est que la fonction prends en charge le zoom a ce niveau de calcul on en a pas besoins

c'est pas compliqué

 

[TooFatBoy]

Merci pour tes tentatives d'explication. mais vu que je ne pige rien à rien, il vaut mieux laisser tomber.

 

[patricktoulon]

 

[patricktoulon]

re
Bonjour à tous
tiens ça c'est juste pour @Dudu2
j'ai changé dans mon tutoriel PointsToScreenPixel la fonction GetPaneOfObject2
si tu veux je t'explique pourquoi

'Function GetPaneOfObject2(obj As Object) As Pane
'Dim X&
'   With ActiveWindow
'   X = 1
'       If .SplitColumn > 0 Then If obj.Left > Cells(1, .SplitColumn).Offset(, 1).Left Then X = 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
'   Set GetPaneOfObject2 = .Panes(X)
'   End With
'End Function



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
        X = 1
        If .SplitColumn > 0 Then If obj.Left > Cells(1, .SplitColumn).Offset(, 1).Left Then X = 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 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
        Set GetPaneOfObject2 = .Panes(X)
    End With
End Function

 

[Dudu2]

Bonjour les chercheurs de pixels,
@patricktoulon,
Si ta 1ère séquence permet de trouver X (je sais pas le dire), je vois pas trop l'utilité de la boucle.
Car si X est correct et que l'objet n'est pas dans le VisibleRange du Pane(X), tu peux boucler tant que tu veux sur les Panes, ça le fera pas rentrer dedans.

 

[patricktoulon]

re
et ben non c'est pas ça du tout dudu2
c'est pour m’éviter de faire des calculs supplémentaires
je t'explique tout à l'heure je suis sur un fichier d'un autre membre là

 

[Dudu2]

OK, je te crois sur parole. Pas de souci.

 

[Dudu2]

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.

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.

 

[patricktoulon]

re
Bonjour @Dudu2
les api windows oui
mais la gestion d'affichage DWM vient foutre le boxon
de tout façon il faut pas aller bien loin
il suffit d’énumérer avec getsystemMetric pour trouver les bordures thick , bordures still et shadow
sauf que ces données ne sont pas valables a moins de shunter le thème Windows X
Mac j'en parlerais pas je peux pas testé et en plus il tourne en pixel

c'est pour ça que essayer de faire des calculs avec autres que les données renvoyée par les fonction de la dwmampi.dll ,c'est chasser le dahu

 

[patricktoulon]

d'ailleurs je l'ai montré en video ici
tu n'a pas du regarder

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

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...

excel-downloads.com

 

[patricktoulon]

RE
@Dudu2 Je te devais une explication sur les modif du changement de ma fonction GetPane
dans cette vidéo j'explique pourquoi

 

[Dudu2]

Bonjour @patricktoulon,
Jolie démonstration de panne de Pane.