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

Nicolas JACQUIN

XLDnaute Occasionnel
Supporter XLD
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
 

Pièces jointes

  • Placement userform.xlsm
    20.5 KB · Affichages: 12

TooFatBoy

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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é
 

patricktoulon

XLDnaute Barbatruc
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

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

Dudu2

XLDnaute Barbatruc
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.
1712307977952.png


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.
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
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

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

Discussions similaires

Statistiques des forums

Discussions
313 204
Messages
2 096 208
Membres
106 529
dernier inscrit
ironmachine