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

Lu76Fer

XLDnaute Occasionnel
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 :
VB:
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.
VB:
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 :
VB:
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
Code:
Call InitLibV11
par
Code:
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
 

Pièces jointes

  • GetScreenPosDemo.xls
    177.5 KB · Affichages: 14
  • GetScreenPosDemo.xlsm
    106.5 KB · Affichages: 24
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
bonjour @TooFatBoy je crois que c'est toi qui n'a pas lu tout le post ;)
je sais parfaitement bien que je ne modifie pas la résolution
mais si chez moi en résolution 1600*900 ou 3680*2160 en zoom 100/125/200/250
le calcul me sort 0.75 il doit en être pareil pour W11 sachant que c'est une mise a jour de novembre 2022 qui a modifié cela dans w10 , je ne vois pas pourquoi W11 n'en ai pas bénéficié
et j'ai testé sur tout les pc W10 au boulot ça donne pareil

de toute façon au vue de la résolution native de @Dudu2 c'est a dire le max qui lui est proposé pour son ecran; pointé par "(native)"
soit Windows ne capte pas la vrai résolution de sa dalle d’écran par ce que c'est un écran made in Pétaouchnok
soit le inf du moniteur plug and play n'a pas été mis a jour
soit son écran à 30 ans et demie

même un 17 pouce va plus haut aujourd'hui en résolution native
@Dudu2 répondra a cela
si il prend la peine d'aller vérifier dans le gestionnaire de périphérique
moniteur --->moniteur plug and play generique
dessus clickdroit
propriété
dans la fenêtre--->onglet détail
dans la combobox propriété choisir "pile de périphérique"

il doit avoir les deux
driver monitor et driver de NVIdia qui commence par "Nvid...."
si il a les drivers OEMXX (xx étant un nombre) c'est que son installation c'est mal passée
crois moi j'ai bien galéré avant de comprendre ça

1697195431914.png


j'aimerais bien voir les résolutions qui lui sont proposées dans les deux panneaux (nvidia et windows/affichage
 

Dudu2

XLDnaute Barbatruc
Moniteur BENQ 21.5" - GL2250HM - 2ms - 1920x1080 acheté 120 € le 08/11/2016.

VB:
Function PixelToPoint() As Double
    Dim K1 As Long
 
    K1 = Application.InchesToPoints(20)
 
    With ActiveWindow
        PixelToPoint = Round(K1 / (.Panes(1).PointsToScreenPixelsX(K1 * (100 / .Zoom)) - .Panes(1).PointsToScreenPixelsX(0)), 2)
        'PixelToPoint = K1 / (.Panes(1).PointsToScreenPixelsX(K1 * (100 / .Zoom)) - .Panes(1).PointsToScreenPixelsX(0))
        'PixelToPoint = 1 / ((.Panes(1).PointsToScreenPixelsX(K1 / (.Zoom / 100)) - .Panes(1).PointsToScreenPixelsX(0)) / K1)
    End With
End Function
 

patricktoulon

XLDnaute Barbatruc
re
2016 je sais pas ça fait 7 ans quand même
faut voir
si un jour tu a l'occasion de tester un autre écran n'hésite pas
attention aussi le port que tu utilise de ta carte graphique
tu a normalement les ports
VGA(bleu ou noir)
DVI (blanc)
hdmi
les deux premiers sont limités sur les geforce gt , gtx, spencer
perso je suis en hdmi d'office
si tu n'a pas ce port sur ton écran en effet il est trop vieux
 

Lu76Fer

XLDnaute Occasionnel
re
bonjour @TooFatBoy je crois que c'est toi qui n'a pas lu tout le post ;)
je sais parfaitement bien que je ne modifie pas la résolution
mais si chez moi en résolution 1600*900 ou 3680*2160 en zoom 100/125/200/250
le calcul me sort 0.75 il doit en être pareil pour W11 sachant que c'est une mise a jour de novembre 2022 qui a modifié cela dans w10 , je ne vois pas pourquoi W11 n'en ai pas bénéficié
et j'ai testé sur tout les pc W10 au boulot ça donne pareil (...)
Bonjour,
Du coup on peut en donc en déduire que le zoom n'a rien à voir avec le Sujet vu qu'il n'influence pas le coef.
et ne change pas la résolution, après il est possible d'ouvrir une nouvelle discussion sur l'optimisation de son pilote d'affichage ...
:rolleyes:
 

Lu76Fer

XLDnaute Occasionnel
Pour être plus précis, le fait de modifier la résolution sur une Dalle précise ne change pas la valeur du coefficient PxToPt. La valeur de PxToPt dépend de la résolution native de sa dalle ...
Correctif :
Après vérification on peu avoir sur deux machines et dalles différentes des PxToPt différent pour une même résolution native. Du coup cela dépend de la dalle simplement.
 
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
chez moi en résolution 1600*900 ou 3680*2160
Sorry but... ça n'a aucun sens.


Pour être plus précis, le fait de modifier la résolution sur une Dalle précise ne change pas la valeur du coefficient PxToPt. La valeur de PxToPt dépend de la résolution native de sa dalle ...

Après vérification on peu avoir sur deux machines et dalles différentes des PxToPt différent pour une même résolution native. Du coup cela dépend de la dalle simplement.
Là, j'avoue que je n'y comprends rien à ce fameux PxToPt, je n'ai toujours pas compris ce que c'est.
Qu'appelles-tu "résolution native" ?


Pardon messieurs, mais savez-vous vraiment ce qu'est une résolution d'écran ou d'affichage ????
PatrickToulon semble ne pas savoir, ou en tout cas il se trompe quand il l'écrit.
Lu76Fer, ce n'est pas toujours clair selon le message posté.
Dudu2, je ne saurais dire, mais en ce jeune Padawan j'ai confiance (non pas que je n'ai pas confiance en PT et LU7). Alors je me dis qu'il le sait. ;)



Bref, s'il vous plait, aidez-moi à y comprendre quelque chose !🙏🤞
 
Dernière édition:

Cousinhub

XLDnaute Barbatruc
Bonsoir,
Encore un fil à émission de gaz à effet de serre...
Sans dec', est-ce qu'avoir son usf à quelques millimètres d'une bordure est si important?
Est-ce que cet usf va bien mieux fonctionner...
Il serait peut-être temps de limiter ce type d'échanges, n'apportant strictement rien au bon fonctionnement d'Excel, ni ne résolvant aucune problématique...
Ceci n'est que mon avis personnel, mais faudrait peut-être se poser les bonnes questions....
A T'chao
 

patricktoulon

XLDnaute Barbatruc
re
moi perso quand une discussion me gonfle je zappe
venir a 2 ou trois reprises pour ne rien apporter( de toute façon ça ne t'intéresse pas)et pester
c'est ça que je trouve pitoyable(pour reprendre tes propres termes ;) )
il y a bien d'autres discussions sur le forum si celle ci te plait pas choisi en une autre
honte à moi même de te te répondre
A T'chao

ps : @Dudu2 j'ai un truc pour ton vbs thunderbird si tu veux
 

Dudu2

XLDnaute Barbatruc
Bonsoir @Cousinhub,
Mais tu nous l'as déjà dit dans l'autre sujet et la réponse serait la même.
D'ailleurs ce n'est pas du tout un sujet pour @Lu76Fer qui ne pratique pas la correction des marges dans son code. Donc il s'en fiche aussi et à ce stade, ceux qui cherchent la précision ont réglé la question.

Le second sujet de cette longue discussion était la conversion Pixel To Point.
Là aussi je crois qu'on a fait le tour.

Maintenant la discussion porte sur tout à fait autre chose:
Résolution d'écran / Nombre de Pixels pour un point défini par quoi / Effet de la mise à l'échelle / Effet du Zoom / Drivers WHQL.
Mais là je crois qu'il va falloir aller aux sources de la définition technique.
 

patricktoulon

XLDnaute Barbatruc
re
tiens
libère toi du code en dur
dans un module du classeur
VB:
Sub testpourargumentvbs()
    destinataire = "toto@ouméméle.feure"
    emetteur = "moi@monmailou.fr"
    sujet = Chr(34) & "envoie de mail" & Chr(34)
    body = Chr(34) & "Bonjour <b>dudu2</b> comment va tu?" & Chr(34) & ""
    With CreateObject("Wscript.Shell")
        .Run "C:\Users\patricktoulon\Desktop\maileurTHB.vbs " & destinataire & " " & emetteur & " " & sujet & " " & body
    End With

End Sub

pour tester un vbs ( à enregistrer en".vbs"
Code:
dim texte
msgbox wscript.Arguments.count & "arguments injectés"
texte=texte & "destinataire=" & WScript.Arguments(0) & vbcrlf
texte=texte & "emetteur =" & WScript.Arguments(1) & vbcrlf
texte=texte & "sujet=" &    WScript.Arguments(2) & vbcrlf
Texte = Texte &"body="  & WScript.Arguments(3) & vbcrlf
msgbox texte
tu pourra ainsi appeler ton vbsthunderbird a partir d'un classeur ;)
IMPORTANT!!!
les variable dans vba contenant des espaces devront être encadrées par un guillemet
 

Discussions similaires

Statistiques des forums

Discussions
312 367
Messages
2 087 644
Membres
103 627
dernier inscrit
nabil