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

 

[Dudu2]

En fait à partir de 400, que ce soit 400, 1000, 10000 ça ne change rien.
Et je pense que 516 c'est finalement juste un chiffre comme un autre pour le calcul.
Donc 10000 c'était pas si mal

 

[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 % ?

En fait il appelle "dpi 100" un truc qui n'a rien à voir avec des DPI, mais plutôt avec le zoom.
Il mélange deux choses (le zoom du Bureau et les DPI) parce qu'il interprète à l'envers un tableau donné par Microsoft.

Si j'arrive à retrouver ledit tableau, tu verras que c'est pourtant hyper simple à comprendre... à condition de ne pas l'interpréter à l'envers.

Sauf si c'est moi qui n'ai rien compris au tableau de Microsoft, mais ça tombe bien que tu parles de ça car ainsi quelqu'un (en l'occurrence toi) va enfin pouvoir m'éclairer sur ce point.


[edit]
J'ai beau chercher avec mon ami Google, nous ne retrouvons pas ce fameux tableau.
[/edit]

 

[Dudu2]

J'obtiens le plus grand % de résultats exacts avec Application.InchesToPoints(20).

Edit: les autres valeurs ont un écart Max de 3.77 millièmes avec 0.6 ce qui est un excellent score.

Je vais donc opter pour cette valeur.

Function PixelToPoint() As Double
    Dim k As Long
   
    With ActiveWindow
        k = Application.InchesToPoints(20)
        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

 

[Lu76Fer]

J'obtiens le plus grand % de résultats exacts avec Application.InchesToPoints(20).

Edit: les autres valeurs ont un écart Max de 3.77 millièmes avec 0.6 ce qui est un excellent score.

Regarde la pièce jointe 1180858
Je vais donc opter pour cette valeur.

Function PixelToPoint() As Double
    Dim k As Long
  
    With ActiveWindow
        k = Application.InchesToPoints(20)
        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

Le plus important c'est que l'arrondi à 2 chiffres soit exact. 3.77 millièmes < 5 millièmes

 

[Dudu2]

Bonjour,
Oui, en effet car au dessus de 5 millièmes le Round nous ramènerait un centième soit 0.61.
Dans aucun des cas ou k > 400 testés on a cette situation mais parfois on la frôle avec des 4.4 millièmes.

SAUF pour les Zoom 10%, 20% et 40% où invariablement le résultat est respectivement 0.62, 0.59 et 0.59.
C'était peut-être là l'intérêt du Round(x * 20) / 20 correcteur pour ces faibles Zooms mais porteur d'incertitude.

 

[Lu76Fer]

Bonjour @Dudu2,
Dans mes tests à partir de k> #500 plus d'erreur dans l'arrondi quelque soit le zoom et entre 400 et 500 ça dépend de la valeur ... La magie des Maths !! Au final, mon arrondi à 0 ou 5 exige un k aussi élevé donc au final c'est beaucoup mieux ton arrondi à 2 chiffres.
Il faut bien le faire pour calculer PxToPt et pas PtToPx car dans ce cas on a des valeurs irrationnelles (1,6666666...). Par intuition, Je pense que cet arrondi à 2 chiffres existe aussi dans les algos développés par Microsoft.

 

[patricktoulon]

re
juste en passant

 

[Dudu2]

Je voudrais d'abord dire que ces 2 instructions (version @Lu76Fer et @patricktoulon):

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)

sont strictement identiques donc il est normal que les résultats le soient aussi.

Ensuite la Mise à l'échelle de l'affichage.
Que je sois en 100% ou 125% (mon choix car je préfère garder l'écran à 70 cm avec mes corrections de presbyte de 1.75 (vous allez tout savoir !) ou encore à 175%, les résultats sont équivalents ...
Pixel To Point via l'API est toujours 0.6.

Donc cette mise à l'échelle n'a aucune influence sur le nombre de Dots per Inches (je ne sais si Dots veut dire Points ou Pixels).

Chez moi, toujours:

Etc...

 

[Dudu2]

Je pense que la Mise à l'échelle relève d'un "effet loupe" obtenu via la carte graphique ou autrement (je n'en sais rien), mais ne modifie pas les coefficients de base du système.

 

[patricktoulon]

mathématiquement parlant tu a raison mais depuis W10 ca a été corrigé ça
donc normalement en dpi 100 ou 125 tu devrait être toujours a 0.75(la preuve en vidéo)
c'est ce que j'ai voulu dire dans la vidéo
mais visiblement je ne dois pas parler le francais correctement

 

[Dudu2]

C'était pour confirmer ce que tu as vidéotisé .
Et pour confirmer que chez moi les Zooms 10, 20, 40 ne sont pas strictement conformes.
Et ça me gène et m'incite à revenir sur l'API.

 

[patricktoulon]

surtout que je ne vois pas pourquoi il auraient modifié ça chez crosoft pour W10
et il auraient remis des valeurs approximatives sur W11 comme cela l’était sur W7
sur W10 il y a une sorte d'auto conversion ce qui fait que l'on travaille avec un coefficient (point to pixel ou l'inverse comme tu veux ) basique c'est à dire:
1.333333333333333
ou
0.75

 

[Dudu2]

A titre indicatif voici le module de conversion API que j'utilise, rien de particulier, on retrouve l'équivalent un peu partout sur Internet.
Alors ok, le code est plus long, distingue le coefficient en X et en Y, mais on met ça dans un Module est on ne s'en soucie plus.
Changer l'extension .txt en .bas et importer le Module dans les projets VBA concernés.

 

[patricktoulon]

C'était pour confirmer ce que tu as vidéotisé .
Et pour confirmer que chez moi les Zooms 10, 20, 40 ne sont pas strictement conformes.
Et ça me gène et m'incite à revenir sur l'API.

un casse noisette de première m'a dit un jour sur DVP que le zoom n’était pas une loupe
alors attention
par exemple
quand on zoom excel les bordures de la grille ne sont pas zoomées même quand elle sont xlnone

si on devait faire l’opération du nombre de ligne verticales et horizontales * par le zoom et que l'on fasse la différence en zoom 100 et que ce résultat on l'ajoute ou le retire au calculs tu verrais que l'on est plus proche encore
regarde
zoom 400

zoom 200

on voit bien que en 100 elles nous paraissent plus épaisses qu'en 400
et bien d'autres détails aussi comme ça
et c'est pareil pour les controls sur les userforms

donc api ou pas api tu aura toujours des nuances de résultats
et qui puis est ; selon les drivers graphiques utilisés
c'est des tests que j'ai fait il y a des années déjà avec les api
c'est simple depuis VISTA on ne peut plus compter sur elles pour une exactitude à 100%
excel répond correctement jusqu'a 800X600 pixel ce qui est la base Windows tout du moins le noyau NT
après la cohérence (calcul/graphique)c'est de approximatif

 

[patricktoulon]

re
avec ton module api