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

Dudu2

XLDnaute Barbatruc
Oui, chez toi c'est le boxon et ça marche, chez moi c'est l'orthodoxie et ça déconne :eek:.
Je te dis c'est pour ça que je me suis rabattu sur les API. Mais j'aurais pu prendre tes autres solutions ci-dessus.

Après je ne sais pas en multi-moniteurs comment chopper la résolution d'un moniteur donné !
 

patricktoulon

XLDnaute Barbatruc
mais non c'est pas le boxon
c'est juste que j'ai persisté dans la recherche du pourquoi et comment et un membre du forum sur NVIDIA m'a tout expliqué pas à pas ,moi et mon anglais fransisquain 🤣

sérieux le gars il a passé plus de la matinée avec moi

si je te disais que beaucoup de choses dans Windows tournent sur 3 pattes même si on le voit ou que l'on s'en rend pas compte ,pas tu me croirais pas

je peux te l'assurer chez toi ce n'est pas l'orthodoxie en tout cas ce n'est pas de ta faute
après faut le dire vous êtes peut être au bout du proc graphique sur des petits pc c'est possible je sais pas

c'est simple tout les soucis que j'avais concernant le graphique ont disparu
 

patricktoulon

XLDnaute Barbatruc
Bonjour
à minima ca devrait être ça
VB:
'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'placement userform sur cells All conditions
'version allégée 03/2024 pour XLD
'fonctionne sur feuille simple ,  fractionnée , figée
'retrouve la bonne Pane tout seul si l'index pane  injecté est erroné
Option Explicit
Function PositionForm_V_Pat(FORM As Object, rng As Range, Optional Indexpan As Long = 0)
    Dim Z#, LpP#, TpP#, HpP#, WpP#, I%, Marge#, PaN As Pane, PpX#
    '----------------------------
    ' je vous laisse  décider de la méthode de redressage
    'chez moi
    Marge = 1.5
    'With FORM: Marge = ((.Width - .InsideWidth) / 3)  End With

    '---------------------------
    With ActiveWindow

        If Indexpan = 0 Then Set PaN = .ActivePane Else Set PaN = .Panes(Indexpan)
        If Intersect(PaN.VisibleRange, rng) Is Nothing Then
            For I = 1 To .Panes.Count
                If Not Intersect(.Panes(I).VisibleRange, rng) Is Nothing Then Set PaN = .Panes(I)
            Next
        End If
        If Indexpan > 0 Then If PaN.Index <> Indexpan Then MsgBox " la range " & rng.Address(0, 0) & _
         " n'est pas  dans la pane(" & Indexpan & ") mais en panes(" & PaN.Index & ")"

        Z = .Zoom / 100
        PpX = Round(1 / ((.Panes(1).PointsToScreenPixelsX(7200 / Z) - (.Panes(1).PointsToScreenPixelsX(0) * Z)) / 7200), 2)
        LpP = PaN.PointsToScreenPixelsX(rng.Left) * PpX - Marge
        TpP = PaN.PointsToScreenPixelsY(rng.Top) * PpX

        HpP = IIf(rng.Cells.Count > 1, rng.Height * Z + Marge, FORM.Height)
        WpP = IIf(rng.Cells.Count > 1, rng.Width * Z + (Marge * 2), FORM.Width)

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

pour le placer quelque part par macro
exemple en J4 sur une feulle fractionnée
' le centre de la fraction est E8
'la fonction va detecter que c'est pas la bonne pane elle va la trouver toute seule
Code:
Sub placement_form1()
    Dim R
    R = PositionForm_V_Pat(UserForm1, [J3], 4)
    With UserForm1: .Show 0: .Left = R(0): .Top = R(1): End With
End Sub

'pour le placer a la sélection de cellule
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
R = PositionForm_V_Pat(UserForm1, ActiveCell)
    With UserForm1: .Show 0: .Left = R(0): .Top = R(1): End With
End Sub

demo.gif



demo sur feuille fractionnée
demo.gif



demo sur feuille avec ligne et colonne figée
demo.gif


Voila
 
Dernière édition:

Nicolas JACQUIN

XLDnaute Occasionnel
Supporter XLD
escuse j'ai pas vu ta dernière ligne, juste ce code là, module10

VB:
Option Explicit
Function PositionForm_V_Pat(FORM As Object, rng As Range, Optional Indexpan As Long = 0)
    Dim Z#, LpP#, TpP#, HpP#, WpP#, I%, Marge#, PaN As Pane, PpX#
    '----------------------------
    ' je vous laisse  décider de la méthode de redressage
    'chez moi
    Marge = 1.5
    'With FORM: Marge = ((.Width - .InsideWidth) / 3)  End With

    '---------------------------
    With ActiveWindow

        If Indexpan = 0 Then Set PaN = .ActivePane Else Set PaN = .Panes(Indexpan)
        If Intersect(PaN.VisibleRange, rng) Is Nothing Then
            For I = 1 To .Panes.Count
                If Not Intersect(.Panes(I).VisibleRange, rng) Is Nothing Then Set PaN = .Panes(I)
            Next
        End If
        If Indexpan > 0 Then If PaN.Index <> Indexpan Then MsgBox " la range " & rng.Address(0, 0) & _
         " n'est pas  dans la pane(" & Indexpan & ") mais en panes(" & PaN.Index & ")"

        Z = .Zoom / 100
        PpX = Round(1 / ((.Panes(1).PointsToScreenPixelsX(7200 / Z) - (.Panes(1).PointsToScreenPixelsX(0) * Z)) / 7200), 2)
        LpP = PaN.PointsToScreenPixelsX(rng.Left) * PpX - Marge
        TpP = PaN.PointsToScreenPixelsY(rng.Top) * PpX

        HpP = IIf(rng.Cells.Count > 1, rng.Height * Z + Marge, FORM.Height)
        WpP = IIf(rng.Cells.Count > 1, rng.Width * Z + (Marge * 2), FORM.Width)

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

Module 10


Sub placement_form1h()
    Dim R
    R = PositionForm_V_Pat(UserForm1, [J3], 4)
    With UserForm1: .Show 0: .Left = R(0): .Top = R(1): End With
End Sub
 

Pièces jointes

  • Placement userform.xlsm
    45.5 KB · Affichages: 1

Nicolas JACQUIN

XLDnaute Occasionnel
Supporter XLD
module10
c'est quoi ce fichier il y a tout les codes
tu peux pas faire simple ? pour tester
teste celui là plutôt
re, sur la feuille 2 et 3, à par notre décalage différent ça match, mais en zoom c'est cata. et feuille1 regarde mais en zoom c'est dans les choux aussi
 

Pièces jointes

  • test form2.gif
    test form2.gif
    616.5 KB · Affichages: 2
  • test form3.gif
    test form3.gif
    940.1 KB · Affichages: 2

TooFatBoy

XLDnaute Barbatruc
c'est étonnant non tu trouve pas
que chez moi
  1. ou il y a le boxon dans mes drivers
  2. ou j'ai rien compris a calcul dpi
  3. etc..
j'arrive a des calculs constants 🤣
C'est aussi la question que je me pose depuis fort longtemps. 👍

En effet, ça fait des années que j'admire sincèrement ce que tu arrives à obtenir alors tu ne comprends pas les bases de l'affichage.

Je trouve vraiment dommage que tu ne veuilles pas essayer de comprendre ces bases (la preuve, tu continus de parler de "dpi 120" qui n'a toujours aucun sens) car ces lacunes t'empêchent d'avoir un discours cohérent et plus facilement compréhensible.
Du coup, moi je n'arriverais jamais à comprendre quoi que ce soit dans le positionnement des objets avec Excel. 😭 😭 😭 😭 😭


Longue vie et prospérité
🖖
 

patricktoulon

XLDnaute Barbatruc
re
Nicolas d’accords je vais vérifier le zoom

@TooFatBoy je n'ai pas besoins de savoir plus
sachant que sur 2007 et W 7 dès que l'on grossi la taille des caractères dans les paramètres Windows le DPI appliqué et de 120 soit 125% je l'ai pas inventé si tu retrouve les discussions tu verra les captures
parti de la ma formule ppx va renvoyer non pas 0.75 mais 0.6

par contre sur certaine version de W 10 visiblement le dpi appliqué reste 0.75 même en 150%
sur d'autre version de W 10 ca fait comme sur W 7
parti de la les calculs ne sont pas les même et le résultat non plus

alors je sais pas si on doit parler de dpi simulé ou réel c'est comme tu veux mais le résultat il est là
le coefficient ppx change sur W 7

pour le reste je n'ai pas besoins d'en savoir plus

a tu seulement regardé dans ton registre ton dpi appliqué
ou au moins lu avec la formule shell regread
je suis sur que non sinon tu reviendrais pas à la charge avec ce discours

d'ailleurs un jour avec @Dudu2 et d'autre membres(plutôt calés sur la question) dans une discussion on a fait des calculs réels
par rapport a nos dalles
et bien ce n'est pas cohérents avec ce qui est appliqué dans Windows surtout quand on monte a 150% et plus

donc arrête avec ta théorie et vois un peu en pratique avec les données que Windows te donne
 

TooFatBoy

XLDnaute Barbatruc
parti de la ma formule ppx va renvoyer non pas 0.75 mais 0.6
Je ne dis pas le contraire.
D'ailleurs je ne commente pas tes formules de calcul puisque ça me dépasse totalement. C'est bien au-delà de mes connaissances et de ma compréhension du truc. 😥





dès que l'on grossi la taille des caractères dans les paramètres Windows le DPI appliqué est de 120 soit 125%
C'est là une de tes erreurs le dpi n'est absolument pas de 120 quand on monte le zoom à 125 % !

Tu ne veux pas comprendre que si on met tous le zoom à 125 %, on aura tous un dpi différent puisque ça dépend de la taille de la dalle et son nombre de pixels.
Souviens-toi, on avait réfléchi ensemble sur l'absurdité du truc, j'avais fini par trouver ce qui clochait et te l'avais expliqué.

Hélas tu n'en as pas tenu compte et tu restes campé sur ton erreur et parle toujours de "dpi 120".

Rappelle-toi : tu me soutenais être en "dpi 120" et je t'avais démontré par calcul, et un site Web te l'avait confirmé, que tu étais aux alentours de 34 (ou 43, je ne sais plus très bien).





a tu seulement regardé dans ton registre ton dpi appliqué
ou au moins lu avec la formule shell regread
je suis sur que non sinon tu reviendrais pas à la charge avec ce discours
Tu m'avais donné une macro pour qu'elle m'affiche la valeur du registre.
Ça donnait une valeur que tu n'arrivais pas à t'expliquer et qui faussait tes calculs. Tu devais d'ailleurs modifier tes calculs pour qu'ils fonctionnent aussi chez moi, mais tu ne l'as pas fait. 😥
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
C'est là une de tes erreurs le dpi n'est absolument pas de 120 quand on monte le zoom à 125 % !
re
je pige mieux ce que tu me dis
alors
quand je zoom à 125%
mon dpi appliqué est 120 dans le registre
quand je zoom à 100% mon dpi est 96 dans le registre
c'est pour ça que je dis dpi 100 ou 120


la formule dont tu parles c'est celle précédemment citée avec le shell.regread
VB:
'patricktoulon
Sub test()
    dpi = dpix
    MsgBox dpi
    MsgBox PointToPixel(dpi)
    MsgBox PixelToPoint(dpi)
End Sub

Function dpix() As Double
    dpix = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI")
End Function

Function PointToPixel(dpi) As Double
    PointToPixel = dpi / Application.InchesToPoints(1)
End Function

Function PixelToPoint(dpi) As Double
    PixelToPoint = 1 / (dpi / Application.InchesToPoints(1))
End Function
 

Nicolas JACQUIN

XLDnaute Occasionnel
Supporter XLD
re, je sais que je suis têtu :D :D , je cherche juste à comprendre et apprendre, y a rien de méchant.
J'ai commencé à modifier ton dernier code et ça colle en zoom.
j'écoute ta vidéo en même temps ;);)

VB:
Function PositionForm_V_Pat(FORM As Object, rng As Range, Optional Indexpan As Long = 0)
    Dim Z#, LpP#, TpP#, HpP#, WpP#, I%, Marge#, PaN As Pane, PpX#
    '----------------------------
    ' je vous laisse  décider de la méthode de redressage
    'chez moi
    'Marge = 5
    With FORM: Marge = Round(((.Width - .InsideWidth) / 2) - 1, 0): End With

    '---------------------------
    With ActiveWindow

        If Indexpan > .Panes.Count Then MsgBox " il n'y a pas de panes(" & Indexpan & ")": Exit Function
       If Indexpan = 0 Then Set PaN = .ActivePane Else Set PaN = .Panes(Indexpan)
        If Intersect(PaN.VisibleRange, rng) Is Nothing Then
            For I = 1 To .Panes.Count
                If Not Intersect(.Panes(I).VisibleRange, rng) Is Nothing Then Set PaN = .Panes(I)
            Next
        End If
        If Indexpan > 0 Then If PaN.Index <> Indexpan Then MsgBox " la range " & rng.Address(0, 0) & _
         " n'est pas  dans la pane(" & Indexpan & ") mais en panes(" & PaN.Index & ")"

        Z = .Zoom / 100
        PpX = 1 / ((.Panes(1).PointsToScreenPixelsX(7200 / Z) - .Panes(1).PointsToScreenPixelsX(0)) / 7200)
        LpP = PaN.PointsToScreenPixelsX(rng.Left) * PpX - Marge
        TpP = PaN.PointsToScreenPixelsY(rng.Top) * PpX
       
        HpP = IIf(rng.Cells.Count > 1, rng.Height * Z + Marge, 200)
        WpP = IIf(rng.Cells.Count > 1, rng.Width * Z + (Marge * 2), 200)
       
        With FORM: .Label1.Caption = "Marge : ((.InsideWidth - .Width) / 2) -1  = " & Marge: End With

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

Discussions similaires

Statistiques des forums

Discussions
312 505
Messages
2 089 103
Membres
104 032
dernier inscrit
akram.job