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

Nicolas JACQUIN

XLDnaute Impliqué
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: 13

TooFatBoy

XLDnaute Barbatruc
J'ai pas dis que c'était un code qui marchais à 100% à la base, c'était juste pour voir chez qui ça fonctionnait
Je viens d'essayer, et avec ton code ça marche nickel, avec celui de PT ça décale de quelques pixels vers la droite comme on peut le voir sur la capture de Dudu2.

Toujours Windows 10 Pro 64 bits 22H2 - Excel 2016 32 bits
 
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
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.
Saurais-tu me dire pourquoi il n'y a que chez PT qu'il n'y a pas ce décalage que l'on voit sur ta capture d'écran et qu'on a tous (sauf PT) chez nous ?

Je sais qu'il utilise une configuration graphique que j'appellerai "bancale", genre dalle UHD et définition du Bureau en 1600x900. Est-ce cela qui pourrait expliquer sa différence ?
 

patricktoulon

XLDnaute Barbatruc
@TooFatBoy
elle est pas bancale bien au contraire
je vous l'ai expliqué déjà
quand je règle à 1600*900 par les paramètres windows
j'ai ce décalage
quand je le règle à 1600*900 en 1080p avec le gestionnaire NVIDIA
je n'ai plus besoins de + ou moins toute ces broutilles
autrement dit le gestionnaire NVIDIA va un peu plus loin que le gestionnaire Windows c'est tout
 

TooFatBoy

XLDnaute Barbatruc
Ce qui est "bancal", c'est que (si je ne me trompe) tu as une dalle UHD et tu configures le Bureau en 1600x900, donc tu as 2,4x2,4 pixels de ta dalle qui forment 1 pixel de ton Bureau... 😵‍💫

Ce qu'il faudrait que tu testes, c'est de passer ton Bureau en UHD (si ta dalle est bien UHD) et voir si tu as toujours cette différence par rapport à nous.
 

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Tiens @Dudu2 une version un peu plus condensée
pour tester met tout dans la feuille et met un userform

VB:
Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function DwmGetWindowAttribute Lib "dwmapi.dll" (ByVal hwnd As LongPtr, ByVal dwAttribute As Long, ByRef pvAttribute As Any, ByVal cbAttribute As Long) As Long
#Else
    Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function DwmGetWindowAttribute Lib "dwmapi.dll" (ByVal hwnd As Long, ByVal dwAttribute As Long, ByRef pvAttribute As Any, ByVal cbAttribute As Long) As Long
#End If

Private Enum DWMWINDOWATTRIBUTE
    DWMWA_NCRENDERING_ENABLED = 1
    DWMWA_NCRENDERING_POLICY
    DWMWA_TRANSITIONS_FORCEDISABLED
    DWMWA_ALLOW_NCPAINT
    DWMWA_CAPTION_BUTTON_BOUNDS
    DWMWA_NONCLIENT_RTL_LAYOUT
    DWMWA_FORCE_ICONIC_REPRESENTATION
    DWMWA_FLIP3D_POLICY
    DWMWA_EXTENDED_FRAME_BOUNDS
    DWMWA_LAST
End Enum
Private Type RECT: Left As Long: Top As Long: Right As Long: Bottom As Long: End Type

Private Function ecart(Lcaption$, UfLeft#, UfTop#) As RECT
    Dim rectangle As RECT, HandleUsF As Long, ppx#, z
    With ActiveWindow
        z = .Zoom / 100
        ppx = ((.Panes(1).PointsToScreenPixelsX(72) - .Panes(1).PointsToScreenPixelsX(0)) / 72) / z
    End With
    ecart.Left = 0: ecart.Top = 0
    HandleUsF = FindWindowA(vbNullString, Lcaption)
    DwmGetWindowAttribute HandleUsF, DWMWA_EXTENDED_FRAME_BOUNDS, rectangle, LenB(rectangle)
    ecart.Left = IIf(rectangle.Left / ppx <> 0, UfLeft - (rectangle.Left / ppx), 0)
    ecart.Top = IIf(rectangle.Top / ppx <> 0, UfTop - (rectangle.Top / ppx), 0)
End Function
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim pos, Ecx As RECT, x&
    pos = PositionForm_V_Pat(ActiveCell)
    With UserForm1
        .Show 0
        Ecx = ecart(.Caption, .Left, .Top)
        .Move pos(0) + Ecx.Left, pos(1) + Ecx.Top
    End With
End Sub
Function PositionForm_V_Pat(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)
        #If Mac Then
            ppx = 1
        #End If
        LpP = .ActivePane.PointsToScreenPixelsX(rng.Left) * ppx
        TpP = .ActivePane.PointsToScreenPixelsY(rng.Top) * ppx
    End With
    PositionForm_V_Pat = Array(LpP, TpP)
End Function
Bonjour Patrick,
J'ai essayé ton code, mais tu as quand même des décalages dessus, top et left, rien quand zoom110.
Moi avec mon minable code je suis monté jusqu'à 150 et aucun decalage
Et les API c'est dommage j'y connait rien du tout
Bon lundi.
 

Pièces jointes

  • ton code.jpg
    ton code.jpg
    31.7 KB · Affichages: 3
  • Mon code.jpg
    Mon code.jpg
    35.8 KB · Affichages: 1
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
@TooFatBoy
elle est pas bancale bien au contraire
je vous l'ai expliqué déjà
quand je règle à 1600*900 par les paramètres windows
j'ai ce décalage
quand je le règle à 1600*900 en 1080p avec le gestionnaire NVIDIA
je n'ai plus besoins de + ou moins toute ces broutilles
autrement dit le gestionnaire NVIDIA va un peu plus loin que le gestionnaire Windows c'est tout
Ça semble surtout prouver que tu as un beau bazar au niveau des drivers de ta CG... puisque tu sembles avoir deux drivers différents (celui de Windows et celui de nVidia) qui n'agissent pas de la même façon. 🤪
 

patricktoulon

XLDnaute Barbatruc
re
Tout est dit
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Z#, LpP#, TpP#
    With ActiveWindow
       Z = .Zoom / 100
        ppx = 1 / ((.Panes(1).PointsToScreenPixelsX(7200 / Z) - .Panes(1).PointsToScreenPixelsX(0)) / 7200)
        LpP = .ActivePane.PointsToScreenPixelsX(Target.Left) * ppx - 1.5
        TpP = .ActivePane.PointsToScreenPixelsY(Target.Top) * ppx
End With

    With UserForm1
        .Show 0
         .Move LpP, TpP
     End With
End Sub
 

TooFatBoy

XLDnaute Barbatruc
Moi, j'aimerais bien savoir pourquoi tu es le seul à ne pas avoir de décalage avec ton code.
Est-ce que ça vient de la configuration de tes drivers vidéos ?
Est-ce que ça vient des drivers eux-mêmes ?
Est-ce à cause de ton "1080i" qui n'en est pas ? (nVidia doit bidouiller le signal vidéo pour le faire passer pour du 1080i/30 afin qu'il soit compatible avec des signaux vidéos HDMI)

Et pourquoi, si tu as un seul driver graphique, il ne réagit pas pareil selon l'interface que tu utilises pour le configurer.
As-tu essayé de passer ton Bureau en UHD ? Peux-tu nous montrer une capture d'écran ?



allez regarde ça
Ça ne m'était pas adressé, mais je me suis tout de même farci la vidéo et franchement, ça fait quand même peur d'entendre autant d'absurdités dans une seule phrase : "Je peux monter très haut en résolution (en 4K) parce que j'ai une carte très puissante et un très grand écran". 😲

- La résolution 4K... 🤣

- C'est bien connu : plus l'écran est grand, plus la résolution est élevée... 🤣
À la limite c'est en réalité bien sûr l'inverse, mais de toute façon on peut avoir n'importe quelle résolution pour n'importe quelle taille d'écran !

- Il est évident qu'il faut une CG très puissante pour afficher le Bureau de Windows en UHD... 🤣
Je dois avoir la CG la moins puissante du monde sur mon vieux PC et je peux bizarrement utiliser mon moniteur pour afficher deux Bureaux en UHD... Étonnant, non ?!?


Je comprends bien que le texte de la vidéo n'a pas été écrit à l'avance et qu'il est dit "comme il vient", mais tout de même moi j'vous l'dit ma bonne dame, y a d'l'abus ! 😂


OK, tu n'y connais pas grand chose en informatique et tu as des bases qui sont malheureusement erronées en ce qui concerne l'affichage en général et sous Windows en particulier. Y a pas de souci avec ça, personne ne peut tout connaître sur tout.
Mais tu devrais absolument reprendre les bases de l'affichage pour que tu puisses enfin comprendre que "dpi120" (dont tu as parlé à plusieurs reprises ces dernières années, dans d'autres fils de discussion) ne veut rien dire, que tu confonds plusieurs choses, et tu comprendrais enfin ce que représente des "dpi".
Ainsi on parlerait tous le même langage non erroné et tu pourrais expliquer clairement à tout le monde ta méthode de calcul sur le positionnement des objets sous Excel (chose que j'attends avec grande impatience car j'aimerais bien savoir faire ce que tu arrives à faire).
 
Dernière édition:

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
A patrick,

Tu n'arrete pas avec tes pilote générique de windows, mais te t'ai déjà envoyé l'image, je passe aussi par NVIDIA pour mettre à jour ma CG, la tienne est peu être puissante, mais bon moi je suis en ultra sur la mienne
 

Pièces jointes

  • Capture d’écran 2024-03-26 220931.jpg
    Capture d’écran 2024-03-26 220931.jpg
    58.1 KB · Affichages: 2
  • carte.jpg
    carte.jpg
    158.9 KB · Affichages: 3

Dudu2

XLDnaute Barbatruc
En parallèle de vos discussions sur les drivers, j'ai retenu cette phrase:
Et les API c'est dommage j'y connait rien du tout
pour trouver une réponse simple.

Alors les API, tu n'as pas à t'en soucier, et dans le fichier joint, il suffit d'inclure dans le projet VBA le Module_GetUserFormMarginsPoints et d'appeler la fonction GetUserFormMarginsPoints.

Cette fonction est utilisable dans le cadre d'un UserForm ou indépendamment.
Le Module_TestMarges est une exemple d'appel de la fonction.
 

Pièces jointes

  • Marges UserForm via API.xlsm
    48.7 KB · Affichages: 1
Dernière édition:

Dudu2

XLDnaute Barbatruc
Détail pour les forts en UserForm...
Puisque la fonction indiquée au message précédent est indépendante du contexte UserForm, il a donc fallu, si nécessaire, charger le UserForm s'il ne l'était pas déjà afin d'obtenir son Handle nécessaire aux fonctions API.
La difficulté a donc été de déterminer si un UserForm est chargé ou pas !

En effet, toute référence à une propriété d'un UserForm (.Name, .Caption) ou même le simple fait le passer en argument d'une fonction a pour effet de le charger en mémoire et d'activer l'évènement UserForm_Initialize().
C'est pour ça que dans la fonction, on passe non pas le UserForm en tant qu'objet, mais son nom en tant que String sans utiliser un propriété du genre UserForm.Name. Cela permet effectivement de savoir si le UserForm a été préalablement chargé par le code appelant sans que le code de la fonction n'ait pour effet indirect de le charger elle-même.
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
315 093
Messages
2 116 138
Membres
112 669
dernier inscrit
Guigui2502