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

 

[TooFatBoy]

alors pour les tests je l'ai testé sur mon W7 en dpi125 et mon W10 en dpi100 qui change pas avec le zoom windows
et là pour le coup j'ai bien le dpi 125% sur mon W7

J'essaye une 2001e fois, sait-on jamais...

Renseigne-toi sur ce que veut dire "dpi" et tu comprendras que "dpi125" ne veut absolument rien dire. Et c'est bien sûr pareil pour "dpi 125%".
C'est dommage car du coup tes écrits n'ont pas non plus de sens, et ça ne m'aide pas pour essayer de comprendre comment tu procèdes.

Tu te mélanges les crayons avec le zoom de Windows, je pense.
C'est bien ça ??? Quand tu écris "dpi125" ou "dpi 125%", tu parles d'une seule et même chose que tu nommes de façons différentes, et qui est en réalité le zoom du Bureau ?

Si ce n'est pas ça, qu'appelles-tu "dpi125" et qu'appelles-tu "dpi 125%" ?

 

[Lu76Fer]

Function GetpxToPt()
    Dim k1, k2
    k1 = 15
    With ActiveWindow
        Z = .Zoom / 100
        'comment obtient on 15 points  en pixel?
        k2 = .Panes(1).PointsToScreenPixelsX(k1 / Z) - .Panes(1).PointsToScreenPixelsX(0)
        pttopx = k2 / k1
        pxtopt = 1 / pttopx
'(...)
    GetpxToPt = pxtopt
End Function

Sub test2()
    MsgBox GetpxToPt
End Sub

les résultats chez moi sont logiques et justes

Re :
GetpxToPt c'est la même fonction que Dudu2 avec k1=15 au lieu de k1=750 ... Du coup cela ne peut pas donner de bon résultat ...

 

[Dudu2]

@Lu76Fer,
Chez moi, en appliquant ton calcul (ou le mien ou encore celui de @patricktoulon qui sont équivalents) quelque soit la valeur de K1 j'ai un souci avec les faibles zooms (toujours les mêmes valeurs d'ailleurs):

Donc, si besoin de précision, je n'utilise pas ce calcul privilégiant les calculs:
- Registre et Macro4 de @patricktoulon
- API

 

[Lu76Fer]

@Lu76Fer,
Chez moi, en appliquant ton calcul (ou le mien ou encore celui de @patricktoulon qui sont équivalents) quelque soit la valeur de K1 j'ai un souci avec les faibles zooms (toujours les mêmes valeurs d'ailleurs):
Regarde la pièce jointe 1181421

Donc, si besoin de précision, je n'utilise pas ce calcul privilégiant les calculs:
- Registre et Macro4 de @patricktoulon
- API

Dommage je croyais que ce serait bon ...

 

[Lu76Fer]

J'essaye une 2001e fois, sait-on jamais...

Renseigne-toi sur ce que veut dire "dpi" et tu comprendras que "dpi125" ne veut absolument rien dire. Et c'est bien sûr pareil pour "dpi 125%".
C'est dommage car du coup tes écrits n'ont pas non plus de sens, et ça ne m'aide pas pour essayer de comprendre comment tu procèdes.

Tu te mélanges les crayons avec le zoom de Windows, je pense.
C'est bien ça ??? Quand tu écris "dpi125" ou "dpi 125%", tu parles d'une seule et même chose que tu nommes de façons différentes, et qui est en réalité le zoom du Bureau ?

Si ce n'est pas ça, qu'appelles-tu "dpi125" et qu'appelles-tu "dpi 125%" ?

Ça me rappelle une anecdote avec un scooter des mers que j'avais loué et je roulais sur l'autoroute à 298 litres / Volt-Ampère ...

 

[patricktoulon]

c'est bizarre car tu n'a pas une résolution mappé importante 1900 par xxxx
c'est pas enorme donc loin des limites de ta GTX
a mon avis c'est ton écran qui est vieillot et ta carte n'arrive pas a ajuster
il te faut donc paramétrer ta propre résolution personnalisée dans le panneau nvidia et tu verra que tes chiffres vont sortir bons

 

[TooFatBoy]

c'est bizarre car tu n'a pas une résolution mappé importante 1900 par xxxx

Quand tu chercheras "dpi", tu chercheras aussi "résolution" pour savoir ce que c'est.

Si tu ne trouves pas l'un ou l'autre, tu peux me demander, j'essayerai de t'expliquer ces deux notions de base, et en échange (si tu le veux bien) tu m'expliqueras tous ces calculs infiniment complexes pour moi.


Bonne soirée

 

[Lu76Fer]

Quand tu chercheras "dpi", tu chercheras aussi "résolution" pour savoir ce que c'est.

Si tu ne trouves pas l'un ou l'autre, tu peux me demander, j'essayerai de t'expliquer ces deux notions de base, et en échange (si tu le veux bien) tu m'expliqueras tous ces calculs infiniment complexes pour moi.


Bonne soirée

Je vais déjà t'expliquer cet algo du coup :

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

Voir le doc ci-joint pour le détail ...

 

[Dudu2]

@patricktoulon,
Je n'ai plus les drivers NVIDIA car j'ai dû restorer mon disque système (Macrium Reflect) suite à une installation foireuse pour retrouver gpedit.msc sur Windows 10. Le script d'installation bouclait et je me suis dit qu'il valait mieux que j'efface toute la m*** qu'il avait ajoutée. Ceci dit, je pourrais les ré-installer.
Mais je me souviens avoir essayé plusieurs résolution et le résultat était identique.

De toutes façons si ça me fait ça à moi, ça peut le faire à n'importe qui donc je ne peux pas inclure dans du code un truc à risque.

 

[patricktoulon]

re
j'ai testé tout les pc w 10 et 11 et 2 qui sont encore en windows 7 au boulot
et tous m'ont rapporté 0.75 ou 06 en dpi 125% ou 100%
les ecran vont de 17 pouces à 24 pouces

 

[Dudu2]

Tu as fait le test pour les Zooms < 50 % ?

 

[patricktoulon]

de 10 à 400 par pas de 5

 

[Dudu2]

Ok, je dois avoir une config spéciale alors !

 

[TooFatBoy]

Je vais déjà t'expliquer cet algo du coup :

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

Voir le doc ci-joint pour le détail ...

Merci, je regarderais ça en fin de semaine.


Tschüss