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]

re
de toute facon je le redis a part 100 125 144 pointstoscreenpixels ne pourra pas gérer
alors la question ne se pose pas
pour info j'ai déjà essayé

 

[TooFatBoy]

Je suis parti de cette observation que ce coef PxToPt finissait toujours par 0 ou 5 mais j'aurai eu besoin de la confirmation d'autres utilisateurs car j'ai que 2 écrans et sur un j'ai un coef de 0.75 et sur l'autre 0.60. Cela reste faible comme observation statistique !

Si ce fameux coefficient dépend de l'écran, ça veut dire qu'il y a autant de valeurs que de modèles d'écran ?

T'as une macro à proposer pour mesurer ça et afficher le résultat ?

 

[patricktoulon]

pour info
à noter que chez moi

PtoPx = 1 / ((.Panes(1).PointsToScreenPixelsX(7200 / Z) - .Panes(1).PointsToScreenPixelsX(0)) / 7200) 'coeff point to pixel

Z etant le zoom/100

que je soit en dpi 100 ou 125% j'obtiens toujours 0.75 ou 0.6
et cela même en forçant le rond a 4 décimal
et là je le redis quand on a les drivers graphique WHQL ça va tout de suite mieux

 

[Lu76Fer]

Si ce fameux coefficient dépend de l'écran, ça veut dire qu'il y a autant de valeurs que de modèles d'écran ?

T'as une macro à proposer pour mesurer ça et afficher le résultat ?

Exact !
J'ai regarder les valeur de DPI qui réponde à mon observation :
60 72 80 90 96 120 144 160 180 240
Je pense que dans la majorité des cas cela fonctionne mais il y a certainement des écrans avec un DPI différent. De plus je n'ai rien trouvé qui conforterait mon hypothèse ...
Pour généraliser je n'ai que ma 2ème fonction dont je parle un peu plus haut et qui est moins élégante et force Excel à donner sa correspondance d'1 pixel en point.
Si quelqu'un à mieux, mais je n'aime pas non plus une formule dont la précision du résultat dépend de la valeur du Zoom...

 

[Lu76Fer]

pour info
à noter que chez moi

PtoPx = 1 / ((.Panes(1).PointsToScreenPixelsX(7200 / Z) - .Panes(1).PointsToScreenPixelsX(0)) / 7200) 'coeff point to pixel

Z etant le zoom/100

que je soit en dpi 100 ou 125% j'obtiens toujours 0.75 ou 0.6
et cela même en forçant le rond a 4 décimal
et là je le redis quand on a les drivers graphique WHQL ça va tout de suite mieux

Désolé par avance pour mon manque de connaissance mais je ne comprend pas de quel DPI tu parles ici, le seul DPI que je connaisse s'exprimant en Pixel / Pouce et pas en % ?

 

[Lu76Fer]

De toutes façons ces considérations sur des notions supposées acquises et définies sont très intéressantes.
Personnellement j'en ai tiré des enseignements sur la manière de faire.
1 - Partir d'un calcul Pixel To Point selon la méthode de @Lu76Fer car c'est beaucoup plus sûr.
2 - Se contenter d'un arrondi à 2 décimales
3 - D'où les fonctions:

Function PixelToPoint() As Double
    Const K1 As Long = 10000
  
    With ActiveWindow
        PixelToPoint = Round(K1 / (.Panes(1).PointsToScreenPixelsX(K1 * (100 / .Zoom)) - .Panes(1).PointsToScreenPixelsX(0)), 2)
    End With
End Function

Function PointToPixel() As Double
    PointToPixel = 1 / PixelToPoint
End Function

Je n'avais pas compris mais du coup tu augmentes la distance pour une meilleure précision en considérant que seuls les 2 chiffres après la décimale sont significatifs !
Je viens de tester toutes les valeurs entières de zoom de 10 à 400 avec des hauteurs et des largeurs de ligne et colonne définies aléatoirement et ça marche ! Toujours le même résultat !
Si tu le permets je vais reprendre ta fonction et modifier ma démo ...
Merci pour ton investissement.

 

[TooFatBoy]

Désolé par avance pour mon manque de connaissance mais je ne comprend pas de quel DPI tu parles ici, le seul DPI que je connaisse s'exprimant en Pixel / Pouce et pas en % ?

2000 fois que je le lui dit...

 

[Lu76Fer]

Si ce fameux coefficient dépend de l'écran, ça veut dire qu'il y a autant de valeurs que de modèles d'écran ?

T'as une macro à proposer pour mesurer ça et afficher le résultat ?

Du coup tu as la réponse avec la fonction de Dudu2 !

 

[TooFatBoy]

Du coup tu as la réponse avec la fonction de Dudu2 !

? ? ?

 

[Lu76Fer]

? ? ?

Je ne répond pas à ta question mais le calcul donne le coefficient mais sans avoir de données système. Du coup pas besoin de fonction de l'API windows ...
Perso j'ai du changer d'écran avec la même config PC, avec mon petit écran j'obtenais 0.6 et avec le plus large 0.75
Le nombre de Pixel / Point si on ne change pas de résolution est une donnée Physique propre à la taille physique de l'écran.

 

[Lu76Fer]

? ? ?

Par contre ce qui m'échappe c'est que je ne retrouve pas mon Coef PxToPt=0.75 en mesurant la largeur de mon écran et en calculant le ratio Nombre de pixel en largeur / Largeur en point ... Je me retrouve avec un coef d'environ de 1.42 ... Pourrais-tu m'éclairer sur la question ?

 

[TooFatBoy]

Par contre ce qui m'échappe c'est que je ne retrouve pas mon Coef PxToPt=0.75 en mesurant la largeur de mon écran et en calculant le ratio Nombre de pixel en largeur / Largeur en point ... Je me retrouve avec un coef d'environ de 1.42 ... Pourrais-tu m'éclairer sur la question ?

C'est pour ça que je voulais tester sur deux écrans tant que j'étais au boulot, pour augmenter les stats.

 

[Lu76Fer]

C'est pour ça que je voulais tester sur deux écrans tant que j'étais au boulot, pour augmenter les stats.

Je pense que c'est la résolution de l'écran qui impacte le coef PxToPt qui est en général lié à l'écran (1 résolution propre à l'écran). Mais la distance en point ne concerne pas l'écran mais le rendu sur une impression afin d'avoir des distances précises à l'impression.
Une colonne de largeur 100 points fera environ l'équivalent en cm (soit 3.53) cm sur l'impression sortie.

 

[Dudu2]

@Lu76Fer,
Je me suis intéressé à ce chiffre intrigant de 11520 dans ton calcul original (que tu as peut-être copié de quelque part ?)

PxToPt = Round(11520 / (.Panes(1).PointsToScreenPixelsX(57600 / .Zoom) - .Panes(1).PointsToScreenPixelsX(0))) / 20

En fait 11520 c'est 576 * 20 soit 72 * 8 * 20.
Alors 20 on sait pourquoi, c'est pour ce calcul d'arrondi à 0 ou 5 en 2ème décimale.
Et 576 c'est 72 * 8 soit Application.InchesToPoints(8) chez moi et je pense que c'est un chiffre assez général.

Ce chiffre de 516 suffit à faire un calcul du Pixel To Point (au lieu de 10000 ou 7200) et curieusement donne souvent le résultat exact en variant le zoom. Je pense que ce n'est pas un hasard.

Donc je suis tenté de modifier les fonctions du Post #60 comme suit:

Function PixelToPoint() As Double
    Dim k As Long
 
    k = Application.InchesToPoints(8)
 
    With ActiveWindow
        PixelToPoint = Round(k / (.Panes(1).PointsToScreenPixelsX(k * (100 / .Zoom)) - .Panes(1).PointsToScreenPixelsX(0)), 2)
    End With
End Function

Function PointToPixel() As Double
    PointToPixel = 1 / PixelToPoint
End Function

Ok, ça change rien mais ça me plait plus

 

[Lu76Fer]

@Lu76Fer,
Je me suis intéressé à ce chiffre intrigant de 11520 dans ton calcul original (que tu as peut-être copié de quelque part ?)

PxToPt = Round(11520 / (.Panes(1).PointsToScreenPixelsX(57600 / .Zoom) - .Panes(1).PointsToScreenPixelsX(0))) / 20

En fait 11520 c'est 516 * 20 soit 72 * 8 * 20.
Alors 20 on sait pourquoi, c'est pour ce calcul d'arrondi à 0 ou 5 en 2ème décimale.
Et 516 c'est 72 * 8 soit Application.InchesToPoints(8) chez moi et je pense que c'est un chiffre assez général.

Ce chiffre de 516 suffit à faire un calcul du Pixel To Point (au lieu de 10000 ou 7200) et curieusement donne souvent le résultat exact en variant le zoom. Je pense que ce n'est pas un hasard.

Regarde la pièce jointe 1180847

Donc je suis tenté de modifier les fonctions du Post #60 comme suit:

Function PixelToPoint() As Double
    Dim k As Long
 
    k = Application.InchesToPoints(8)
 
    With ActiveWindow
        PixelToPoint = Round(k / (.Panes(1).PointsToScreenPixelsX(k * (100 / .Zoom)) - .Panes(1).PointsToScreenPixelsX(0)), 2)
    End With
End Function

Function PointToPixel() As Double
    PointToPixel = 1 / PixelToPoint
End Function

Ok, ça change rien mais ça me plait plus Regarde la pièce jointe 1180848

En faite comme j'avais une valeur de zoom qui ne marchait pas j'ai multiplié par 8 (un peu au pif) et après plus de problème. Prendre 10000 et arrondir à 2 chiffres après la virgule c'était plutôt efficace !
Après vérification ça marche pour tout zoom à partir d'un coef au delà de #500.
Et bien tu as fait chauffer le moulin