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

Nico_J · 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

sylvanu · 31 Mars 2024

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

Nico_J · 31 Mars 2024

sylvanu à dit:
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

Dudu2 · 31 Mars 2024

Bonjour,
Ou sinon on a aussi ça:

VBA - Positionner un UserForm sur un Objet d'une Feuille (Cellule, Contrôle, Forme, Image, etc...)

Le fichier à télécharger contient: Le Module_PositionUserFormOnSheetO à importer dans le projet VBA. Le Module_Test comme exemple de mise en œuvre. Note: Voir toutes mes ressources -> https://excel-downloads.com/resources/?creator_id=268468...

excel-downloads.com

Dudu2 · 31 Mars 2024

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.

VBA - Positionner un Objet par rapport à un autre Objet - Principal concerné... le UserForm

Le fichier à télécharger contient: Le Module_PositionObjectOnObject est à inclure dans le projet VBA. Il contient la fonction PositionObjectOnObject() dont les arguments sont décrits dans le code. Le Module_Test qui présente de nombreux...

excel-downloads.com

TooFatBoy · 31 Mars 2024

Bonjour,

sylvanu à dit:
j'obtiens un très léger mieux à gauche de l'userform sur l'alignement colonne avec :

VB:

.Left = lleft - 1 .Top = ttop - 1

Si, comme moi, on considère que la bordure ne fait pas partie de la cellule, alors c'est "moins bien" avec le "- 1".

Nico_J · 31 Mars 2024

TooFatBoy à dit:
Bonjour,

Si, comme moi, on considère que la bordure ne fait pas partie de la cellule, alors c'est "moins bien" avec le "- 1".

Bonjour, merci du retour, c'est quoi votre config ?

patricktoulon · 31 Mars 2024

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

Nico_J · 31 Mars 2024

patricktoulon à dit:
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 !

Nico_J · 31 Mars 2024

Nico_J à dit:
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 !

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.

Dudu2 · 31 Mars 2024

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.

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.

TooFatBoy · 31 Mars 2024

Nico_J à dit:
Bonjour, merci du retour, c'est quoi votre config ?

Je répondais par rapport aux captures d'écran.

Je n'ai pas encore testé ton code.
Si tu en as un qui permette d'afficher le UserForm au bon endroit, donc à l'endroit où on a cliqué, ça m'intéresse.

patricktoulon · 31 Mars 2024

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

patricktoulon · 31 Mars 2024

re
oui voilà @Dudu2 a tout dit
selon le thème windows 7 ou 10 ou 11 il y aura des nuances de résultat
le pauvre Nicolas qui me suivait dans les années folles il en est toujours là

patricktoulon · 31 Mars 2024

re
@TooFatBoy

l'endroit où on a cliqué, ça m'intéresse.

avec l apis getcursorpos oui

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

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Partager cette page

Statistiques des forums