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

Nicolas JACQUIN · 31 Mars 2024

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,

VB:

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,

Code:

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 · 3 Avril 2024

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 · 3 Avril 2024

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

TooFatBoy · 3 Avril 2024

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 · 3 Avril 2024

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

les 60 en point * pt topx
les 21 pixels de la colonne des numéro de ligne
la distance entre le bord de l'écran et le bord de l'application
le tout en pixel bien sur
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 · 3 Avril 2024

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

patricktoulon · 4 Avril 2024

patricktoulon · 4 Avril 2024

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

VB:

'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 · 4 Avril 2024

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 · 4 Avril 2024

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 · 4 Avril 2024

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

Dudu2 · 5 Avril 2024

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 · 5 Avril 2024

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 · 5 Avril 2024

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 · 5 Avril 2024

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

Dudu2 · 5 Avril 2024

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

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

Nicolas JACQUIN

XLDnaute Impliqué

Pièces jointes

TooFatBoy

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

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

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Discussions similaires