XL 2016 Démo pour positionner un UserForm ou ContextMenu sur la grille (Toute version)

[Lu76Fer]

P.J. :

• GetScreenPosDemo.xlsm : la démo
• GetScreenPosDemo.xls : la conversion pour Excel 2003

Cette démo permet de montrez comment positionner un UserForm ou un Menu Contextuel sur une position de la grille
La fonction permettant de convertir une position de la grille en position écran et toutes les fonctions associées sont contenues dans le module 'Lib' et les fonctions assurant la compatibilité avec Excel 2003 dans le module 'LibV11'
Avec ce problème, c'est l'occasion de montrer comment assurer la compatibilité avec toutes les versions depuis 2003 avec la constante de précompilation classique VBA7 mais qui ne répond pas au problème du passage de la version 2003 à 2007. Dans ce cas il faut utiliser du simple code :

XLS2003 = IIf(Val(Application.Version) < 12, True, False)

La fonction permettant d'obtenir la position écran à partir du coin Haut-Gauche d'une cellule est GetScreenGridPos et GetScreenGridPosV11 pour la version Excel 2003.
Remarque : pour plus de détails sur la version XLS 2003 voir le sujet "Calculer la position sur l'écran d'une position sur la grille (XL 2003)" sur le Forum d'"excel-downloads.com"

Les fonctions pane.PointsToScreenPixelsX et pane.PointsToScreenPixelsY d'Excel assure déjà plutôt bien cette fonction (disponible depuis la version Excel 2007) mais comporte une imprécision variant de 1 (zoom à 100%) à 4 (zoom à 400%) pixels qui est corrigé par cette fonction reprenant le principe de l'algorithme développé par Pijaku en éliminant les 2 à 3% de cas d'echec de sa fonction et en améliorant la performance.
Source : voir le sujet "Déterminer les coordonnées en pixels, par rapport à l'écran, du coin supérieur gauche d'une cellule Excel" sur le forum du site "www.developpez.net"
Ce que j'ai corrigé ce sont les cas ou la position déterminée au départ est située en dehors de la grille et qui concerne les cellules du pourtour de la grille. Pour retrouver la grille je me déplace en diagonale en direction de la grille plutôt que de façon rectiligne. Une fois la grille trouvée je cherche le coin de la cellule en me déplaçant de façon rectiligne.

Public Function GetScreenGridPos(ByVal noPane As Integer, ByVal cellTopLeft As Range) As ScreenPos
Dim cel As Range, x As Long, y As Long, crtPane As Pane
Dim wayHor As Integer, wayVert As Integer, state As Byte, totIt As Byte
    Set crtPane = ActiveWindow.Panes(noPane)
    With crtPane
        'Repérer la 1ère ligne et la 1ère colonne du volet
        wayHor = IIf(cellTopLeft.Column = .ScrollColumn, 1, -1)   'Sens Hor
        wayVert = IIf(cellTopLeft.row = .ScrollRow, 1, -1)    'Sens Vert
        x = .PointsToScreenPixelsX(cellTopLeft.Left)
        y = .PointsToScreenPixelsY(cellTopLeft.Top)
        Do
            Set cel = ActiveWindow.RangeFromPoint(x, y)
            If cel Is Nothing Then
                If (state And 2) Then state = state + 2
                x = x + wayHor: y = y + wayVert
            Else
                If state < 3 Then
                    If cel.Left < cellTopLeft.Left Then
                        state = IIf(state = 2, 4, 1)
                        x = x + 1
                    Else
                        Select Case state
                        Case 0: wayHor = 1: wayVert = 0: state = 2
                        Case 1: state = 4
                        Case 2: x = x - 1
                        End Select
                    End If
                End If
                If state > 3 Then
                    If cel.Top < cellTopLeft.Top Then
                        state = IIf(state = 6, 8, 5)
                        y = y + 1
                    Else
                        Select Case state
                        Case 4: wayHor = 0: wayVert = 1: state = 6
                        Case 5: state = 8
                        Case 6: y = y - 1
                        End Select
                    End If
                End If
            End If
            totIt = totIt + 1: If totIt = 20 Then state = 9
        Loop Until state > 7
    End With
    'State = 9 : retour=(0,0)
    GetScreenGridPos.x = IIf(state = 8, x, 0)
    GetScreenGridPos.y = IIf(state = 8, y, 0)
End Function

Le deuxième élément important à calculer est le coefficient permettant de passer d'une grandeur en pixel vers une grandeur en point :
J'ai créer une variable globale 'PxToPt' que je calcule au moment de l'initialisation.
Il existe plusieurs façon de calculer ce coefficient, dont une qui utilise des fonctions systèmes et permet aussi de connaître la résolution de l'écran.
Cf la fonction 'GetScreenData' sur le sujet "Calculer la position sur l'écran d'une position sur la grille (XL 2003)" sur le Forum d'"excel-downloads.com".
Sinon il existe ce calcul très simple que j'ai testé avec toute les valeurs entières de zoom entre 10 et 400 et fonctionne très bien :

Sub SetPxToPt()
    With ActiveWindow
        PxToPt = Round(11520 / (.Panes(1).PointsToScreenPixelsX(57600 / .Zoom) - .Panes(1).PointsToScreenPixelsX(0))) / 20
    End With
End Sub

Cette macro ne peut être utilisée sous Excel 2003 car pane.PointsToScreenPixelsXouY n'existait pas et il y a donc la macro 'SetPxToPtV11' qui détermine le taux par tatonnement. Elle cherche la plus petite hauteur d'une ligne (1 pixel) et interroge excel pour savoir quel est cette hauteur en point.

Les modules 'exemple' permettant de tester les fonctions ci-dessus
Le module 'Ex1' : il met à disposition un menu contextuel qui permet de changer le nombre de volet, le zoom, de changer d'algo pour tester GetScreenGridPos et GetScreenGridPosV11 ...
Le module 'Ex2' :
Il est possible d'afficher le Userform1 depuis le menu contextuel mais dans certaines versions Excel (ou windows), l'affichage du menu contextuel déborde un peu par rapport à la position d'affichage.
La fonction 'SwapWindowStyle', utilisant des fonctions système permet de modifier l'apparence du Userform en le transformant en simple rectangle, est une solution au problème ci-dessus. Accessible depuis le menu avec le bouton 'Basculer en Style Simple'.

Retirer la compatibilité avec Excel 2003 :

• Il faut supprimer le module 'LibV11'
• Dans le module 'Lib' :

Il faut modifier la macro 'InitLib' en remplaçant

Call InitLibV11

par

SetPxToPt

Il faut retirer, dans la fonction 'GetScreenGridPos', la partie en commentaire 'COMP2003'
La fonction 'GetGapSize' n'a pas forcément d'utilité sauf cas particulier et peut être retiré aussi

 

[patricktoulon]

tu peux me dire ce que les entier - les inside font chez toi
msgbox"width : "& me.width-me.insidewidth & vbcrlf & "height : " & me.height-me.insideheight)

 

[Dudu2]

Bonjour la liste,

tu peux me dire ce que les entier - les inside font chez toi

Intéressante question, ça me rappelle une discussion !

Et je signale qu'il existe déjà des ressources pour positionner un UserForm:

• Une simple qui gère le décalage de la marge selon la taille de (Width - InsideWidth) de manière hypothétique car la discussion en question n'a pu aboutir faute de retours fiables.
  
  

  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
  
  
• Une plus complexe qui positionne un Object sur un autre Object (Le UserForm fait partie du deal) et qui gère les marges avec l'API du user32/wmapi.dll.
  
  

  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]

Une simple qui gère le décalage de la marge selon la taille de (Width - InsideWidth) de manière hypothétique car la discussion en question n'a pu aboutir faute de retours fiables.

C'est quand tu cherchais un gars super sympa avec deux moniteurs et prêt à faire plein de tests, mais dont tu avais oublié le pseudo ?

 

[Lu76Fer]

Ca marche aussi sur mes versions d'Excel 32 bits et l'image n'est pas coupée.
C'est pas grave je suis content de cette version, merci pour ton aide.

 

[Dudu2]

C'est quand tu cherchais un gars super sympa avec deux moniteurs et prêt à faire plein de tests, mais dont tu avais oublié le pseudo ?

Et non je ne l'ai pas oublié mais je crois qu'il n'a pas la bonne ancienne version d'Excel et/ou de Windows.
Tu peux me rappeler tes versions ?

Edit: En fait pour la version "simple", je me demande si je ne vais pas intégrer l'API du user32/wmapi.dll pour en finir avec les suppositions et les tests incertains.
De toutes façons c'est une fonction dans un Module autonome donc ça ne mange pas de pain.

Edit: Ah si c'est ch*** car il faut avoir le Handle du UserForm. Et quand le UserForm n'est pas activé (c'est à dire que la demande de position est faite AVANT le .Show), y a pas, donc il faut ruser comme j'ai dû le faire dans la version complexe.

 

[TooFatBoy]

Tu peux me rappeler tes versions ?

C'est écrit dans mon profil : Windows 10 Pro 64 22H2 et Excel 2016 32

 

[Dudu2]

Tu es beaucoup trop moderne pour ce test !
En plus c'est exactement comme moi.

 

[TooFatBoy]

Tu es beaucoup trop moderne pour ce test !

Le µP de mon PC est un Core2Duo. C'est trop moderne aussi ???

 

[Dudu2]

A noter que la version complexe est capable de positionner un UserForm par rapport (dessus, à coté, en haut, en bas etc...) à une TextBox qui est dans un Frame d'un autre UserForm ! Avec correction des marges !
Franchement, on peut pas plus se casser la tête, non ?

 

[patricktoulon]

re

En fait pour la version "simple", je me demande si je ne vais pas intégrer l'API du user32/wmapi.dll pour en finir avec les suppositions.
De toutes façons c'est une fonction dans un Module autonome donc ça ne mange pas de pain.

et bennnnnnnnnnnnnnnn!!! depuis le temps que je te le dis ?
@Lu76Fer pour info
j'ai testé
sur mon pc W10 22h2 build 19045.3448 ;office 2013 pro plus
sur le pc portable W10 22h2 build 19045.3393;office2013 normal
sur pc portable W 7 ;office 2007 et 2013 pro plus

sur les 3 versions 3 résultat différents
et l'explication est simple

cela dit (je le redis encore une fois )quand on déactive le thème les ombres et tout y cointi les mesure sont bonnes
c'est à dire quand l'on remet le thème basic de w10 quand on était encore 22H1
c'est vrai que les différences ne sont pas flagrantes car au début on y fait pas attention
c'est quand j'ai réinitialisé que je m'en suis rendu compte

 

[patricktoulon]

@Dudu2 , @Lu76Fer
je vous ai fait cette vidéo pour vous montrer une bonne fois pour toute que l'astuce
width-insidewidth et pareil pour le height n'est qu'approximative et ne peut en aucun servir de référence
je vous laisse le userform pour vous amuser à tester

 

[Lu76Fer]

@Dudu2 , @Lu76Fer
je vous ai fait cette vidéo pour vous montrer une bonne fois pour toute que l'astuce
width-insidewidth et pareil pour le height n'est qu'approximative et ne peut en aucun servir de référence
je vous laisse le userform pour vous amuser à tester

Bonjour et Merci pour tout tes efforts !
Je me demande si dans ce cas les valeurs Inside non peut-être aucune raison de changer car les éléments en interne ne sont pas repositionnés dans un espace plus étroit.
J'ai testé en ajoutant un Label sur le bord gauche et lorsque j'augmente la bordure gauche celui-ci ce fait recouvrir et reste visible par transparence.
Pour moi ce n'est qu'illusion mais les bordures 'sémantiques', elles, n'ont pas changées.
@Lu76Fer

 

[Dudu2]

@patricktoulon,
Je ne sais pas trop ce que fait cette API, mais si tu affiches le wx et hx, ils restent constants chez moi quelques soient les décalages.

    wx = Me.Width - Me.InsideWidth
    hx = Me.Height - Me.InsideHeight
    MsgBox "wx = " & Format(wx, "0.0") & ", hx = " & Format(hx, "0.0")

Office 2016/64 en Windows 10/64:

Donc ce n'est pas vraiment ce que tu cherches à démontrer et dont je sais bien sûr la variabilité.
Mais je pense que dans le contexte de ce sujet ce n'est pas la peine d'aller plus loin.

 

[patricktoulon]

re
Bonjour
ben bien sur que non les éléments internes ne sont pas replacés
mais le fait est là
si les bordures sont en thick voir plus ,quand tu va faire ton calcul tu aura une partie des bordures qui vont se voir quand tu va découper
regarde sans rien toucher je met le label rouge à 2 de left
regarde comme il est dans VBE et quand le userform est affiché
on voit bien que l'espace n'est pas le même dans VBE et quand il affiché

c'est bien pour ça que je vous dit que cette astuce entier-inside n'est pas universelle
j'ai testé au boulot ce matin sur 8 pc W10
5 d'entre eux avait un thème différent alors que personne n'a touché ça
et le résultat bien évidement est différent
après je te l'accorde
sur mes tests ce matin ça se joue à 1 ou 2 points en plus ou en moins
je testerais demain avec ma méthode api région
après si tu veux vraiment un truc de précision il y a la méthode setparent
qui te dispense de tout calcul pointstoscreenpixel et elle te remet le userform comme tu l'a dans VBE
sans thème windows ou autre et là c'est du micro millimètre

 

[Dudu2]

A propos d'API DwmGetWindowAttribute Lib "dwmapi.dll", voici une fonction qui l'utilise dans la version simple de positionnement d'un UserForm sur un Objet d'une Feuille.
En principe ça devrait fonctionner sur toutes tes configs. En principe !

A noter que cette fonction est aussi valable pour MacOS et dans ce cas n'utilise évidemment pas l'API Windows.

Edit: Petite modif du fichier à 14h55 pour intégrer les paramètres utilisateur de Shift (Horizontal / Vertical) dans le PointsToScreenPixelsX/Y pour leur affecter aussi le zoom. Tant qu'à faire !