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

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Nico,
Win10, XL2007, VBA 6.3
Impec, ça marche.
"Just for the fun", j'obtiens un très léger mieux à gauche de l'userform sur l'alignement colonne avec :
VB:
.Left = lleft - 1
.Top = ttop - 1
1711898014389.png
 

Nicolas JACQUIN

XLDnaute Occasionnel
Supporter XLD
Bonjour Nico,
Win10, XL2007, VBA 6.3
Impec, ça marche.
"Just for the fun", j'obtiens un très léger mieux à gauche de l'userform sur l'alignement colonne avec :
VB:
.Left = lleft - 1
.Top = ttop - 1
Regarde la pièce jointe 1193944
Bonjour,
merci du retour
remplacer la ligne
VB:
With FORM: bord = ((.InsideWidth - .Width) / 2) + 1: End With
par celle si
VB:
With FORM: bord = ((.InsideWidth - .Width) / 2): End With
J'avais un doute, faut que je reface mes lunettes :)
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
Ou même ça pour positionner tout et n'importe quoi sur n'importe quoi et tout, même si le UserForm et ses Controls sont principalement concernés avec un traitement API de ses marges externes qui varient selon les versions d'Office / Windows.
 

patricktoulon

XLDnaute Barbatruc
Bonsoir Nicolas
c’était pour ça le MP ?
désolé de te le dire mais tu a pas avancé d'un yotat
et pour cause excel ne peut pas gérer les écart d'affichage en fonction du thème window

par contre je me pose une question qui me taraude bien
tu peux m'expliquer

VB:
  Hheight = (rng.Height * Ppx) / Ppx * Zom - bord
  Wwidth = (rng.Width * Ppx) / Ppx * Zom - bord * 2

sachant que l'on attend une dimension en point et rng. width ou height te le donne déjà en point

chez moi ce qui fonctionne

VB:
Function PositionForm_V_Pat(FORM As Object, rng As Range)
    Dim Z#, LpP#, TpP#, HpP#, WpP#
      With ActiveWindow
        Z = .Zoom / 100
        ppx = 1 / ((.Panes(1).PointsToScreenPixelsX(7200 / Z) - .Panes(1).PointsToScreenPixelsX(0)) / 7200)
        LpP = .ActivePane.PointsToScreenPixelsX(rng.Left) * ppx - 1.5
        TpP = .ActivePane.PointsToScreenPixelsY(rng.Top) * ppx
                
        HpP = rng.Height * Z + 1.5
        WpP = rng.Width * Z + 3

    End With
    PositionForm_V_Pat = Array(LpP, TpP, HpP, WpP)
End Function

pour info mon width-insidewidth chez moi me donne 4.5 donc inutilisable

voila comme tu vois les calculs ne sont pas pareils
 

Nicolas JACQUIN

XLDnaute Occasionnel
Supporter XLD
Bonsoir Nicolas
c’était pour ça le MP ?
désolé de te le dire mais tu a pas avancé d'un yotat
et pour cause excel ne peut pas gérer les écart d'affichage en fonction du thème window

par contre je me pose une question qui me taraude bien
tu peux m'expliquer

VB:
  Hheight = (rng.Height * Ppx) / Ppx * Zom - bord
  Wwidth = (rng.Width * Ppx) / Ppx * Zom - bord * 2

sachant que l'on attend une dimension en point et rng. width ou height te le donne déjà en point

chez moi ce qui fonctionne

VB:
Function PositionForm_V_Pat(FORM As Object, rng As Range)
    Dim Z#, LpP#, TpP#, HpP#, WpP#
      With ActiveWindow
        Z = .Zoom / 100
        ppx = 1 / ((.Panes(1).PointsToScreenPixelsX(7200 / Z) - .Panes(1).PointsToScreenPixelsX(0)) / 7200)
        LpP = .ActivePane.PointsToScreenPixelsX(rng.Left) * ppx - 1.5
        TpP = .ActivePane.PointsToScreenPixelsY(rng.Top) * ppx
              
        HpP = rng.Height * Z + 1.5
        WpP = rng.Width * Z + 3

    End With
    PositionForm_V_Pat = Array(LpP, TpP, HpP, WpP)
End Function

pour info mon width-insidewidth chez moi me donne 4.5 donc inutilisable

voila comme tu vois les calculs ne sont pas pareils
Re Patrick,

je me doutais que tu cherchais, mais désolé pour toi ça ne fonctionne pas du tout ce que tu viens de sortir
Tu n'as pas voulu me répondre tout à l'heure, je savais très bien pourquoi, et je suis têtu je sais.
En attendant chez d'autre ça fonctionne, y a que chez toi, un pilote peut-être !
 

Pièces jointes

  • Capture d’écran 2024-03-31 182635.jpg
    Capture d’écran 2024-03-31 182635.jpg
    60.3 KB · Affichages: 6

Nicolas JACQUIN

XLDnaute Occasionnel
Supporter XLD
Re Patrick,

je me doutais que tu cherchais, mais désolé pour toi ça ne fonctionne pas du tout ce que tu viens de sortir
Tu n'as pas voulu me répondre tout à l'heure, je savais très bien pourquoi, et je suis têtu je sais.
En attendant chez d'autre ça fonctionne, y a que chez toi, un pilote peut-être !
1711903995081.png


VB:
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
        .TextBox1.Value = "((.InsideWidth - .Width) / 2) + 1  = " & bord ' (le fameux -5 au left)
    End With
End Sub

ben mince alors, c'est propre quand même !!
Tes calendrier fonctionne peut-être chez toi, mais tu as bien vu que la position match que chez toi !
C'est pour ça que je voulais pas relancer le sujet.
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
Pour info, le code de @patricktoulon fonctionne parfaitement chez moi (Windows 10 / Office 2016 64 bits) en retirant les corrections sur Height et Width qui lui sont propres.
VB:
Sub a()
    Dim LTHW() As Variant
   
    LTHW = PositionForm_V_Pat(UserForm1, [B2:D6])
   
    With UserForm1
        .Left = LTHW(0)
        .Top = LTHW(1)
        .Height = LTHW(2)
        .Width = LTHW(3)
        .StartUpPosition = 0
    End With
   
    UserForm1.Show
End Sub

Function PositionForm_V_Pat(FORM As Object, rng As Range)
    Dim Z#, LpP#, TpP#, HpP#, WpP#, ppx#
      With ActiveWindow
        Z = .Zoom / 100
        ppx = 1 / ((.Panes(1).PointsToScreenPixelsX(7200 / Z) - .Panes(1).PointsToScreenPixelsX(0)) / 7200)
        LpP = .ActivePane.PointsToScreenPixelsX(rng.Left) * ppx - 1.5
        TpP = .ActivePane.PointsToScreenPixelsY(rng.Top) * ppx
               
        HpP = rng.Height * Z '+ 1.5
        WpP = rng.Width * Z '+ 3

    End With
    PositionForm_V_Pat = Array(LpP, TpP, HpP, WpP)
End Function

Le UserForm et ses marges extérieures (dont on aperçoit le très léger grisé) sont parfaitement cadrées.

1711904859467.png


Maintenant, pour le décaler de l'équivalent de ses marges latérale extérieure gauche et supérieure il n'y a pas d'autre solution que l'API car le (.Width - .InsideWidth) n'est PAS du tout une solution universelle.
 

patricktoulon

XLDnaute Barbatruc
re
non ca match pas que chez moi
si je les utilise plus ces codes c'est pas pour rien
e tout cas ce que tu a fait aujourd'hui n'est pas loin certes mais c'est pas juste ,on a toujours les mêmes défauts
comment faut il vous expliquer que ce n'est pas possible pour excel de traiter ça
j'ai cherché pendant plus de 10 ans
je connais mon sujet
si je te dis que c'est pas possible de faire un truc qui marche à 100 % pour tous c'est que ce n'est pas possible
et je sais pourquoi
et pour info j'ai mes drivers à jours car j'ai une carte graphique assez puissante
et depuis que j'ai installé mes drivers et gestionnaire je n'ai plus de soucis de ce genre

je n'ai pas besoins de tarabiscoter des calculs absurdes du genre

VB:
Hheight = (rng.Height * Ppx) / Ppx * Zom ....
  Wwidth = (rng.Width * Ppx) / Ppx * Zom ......
au mieux là tu a peut être un arrondi qui va aller sinon c'est le contraire se sera selon le PC

tu t'en rends compte au moins je l’espère 🤣 🤣

après on s'en fou c'est pas 1 millimètre qui me chagrine à moi
 

Discussions similaires

Statistiques des forums

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