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]

Je ne sais pas pourquoi tu veux à tout prix de me démontrer quelque chose que je sais évidemment depuis toujours. Mais j'apprécie quand même tes vidéos .

Si j'utilise l'API pour avoir le ratio de conversion qui est, on est d'accord, constant quelque soit la Mise à l'échelle (100%, 125%, etc...) c'est pour éviter les approximations du calcul SANS API (ton calcul ou celui de @Lu76Fer) pour des Zoom < 50% déjà listées au Post #83:

Quant au quadrillage des lignes / colonnes qui n'est pas zoomé...
Évidemment qu'il ne l'est pas car c'est juste un marqueur qui n'a pas d'existence ni en feuille ni en cellule.
La preuve en est que:

Sub a()
    MsgBox [C10].Left + [C10].Width & " / " & [D10].Left & vbCrLf & _
           [C10].Top + [C10].Height & " / " & [C11].Top
End Sub

Donne:

Et que ce trait a une épaisseur de 0 et donc n'existe pas en tant qu'objet de la feuille.
C'est juste un marqueur visuel qu'il n'y a pas de raison de zoomer puisqu'on le voit quelque soit le Zoom.

 

[Dudu2]

Quant au mécanise de Mise à l'échelle, je ne sais absolument pas comment ça fonctionne.
Je ne sais pas si Windows joue avec la carte graphique ou a son propre mécanisme de grossissement.

Mais il est évidemment qu'il n'est pas propre à Excel puisque TOUS les affichages sont mis à l'échelle.
Et donc je doute fort qu'Excel fasse des calculs pour ajuster son affichage en multipliant par 1.25 ou autre.

C'est un mécanisme général et c'est pour ça que les coefficients Pixel To Point restent constants comme tu l'as montré dans ta vidéo.

 

[patricktoulon]

re
visiblement tu dis je sais déjà mais tu pige pas ce que j'ai essayé de t'expliquer

en plus clair
la ou tu obtiens 0.6 en 125% (avec ou sans api)moi j'obtiens 0.75
c'est là que ça me titille

et je sais que c'est une mise a jour Windows de novembre 2022 qui me l'a modifié puisqu'avant j'avais 0.6 aussi j'avais eu la surprise
je suis donc étonné que toi tu n'ai pas eu cette mise a jour
qui on peut le dire simplifie grandement les choses

 

[patricktoulon]

et si je pousse le bouchon un peu plus loin je monte a 150%
toujours 0.75
c'est pour te dire

 

[Dudu2]

Ça je ne sais pas pourquoi tu as basculé dans les coefficients avec les mises à jour.
Pour moi ça ne devrait dépendre que de l'écran et/ou de la carte graphique et son pilote mais ce n'est qu'une supposition.

Mon système est à jour, mes 3 dernières mises à jour:

 

[patricktoulon]

ben comme je te l'ai dis
si tu n'a pas les drivers WHQL pour ta carte windows te met a jour avec les génériques
c'est tout
si tu faisait l'effort d'aller voir sur tout les driver .com /onglet drivers / télécharger l'utilitaire et lancer la détection
même si tu veux rester comme ça et pas télécharger tes drivers tu verrais que tu marche avec un affichage boiteux
tu serais surpris de la qualité de ton affichage a mon avis

va juste voir et lance la détection ne serait ce que pour le savoir au moins

 

[Dudu2]

Ok, sur le site j'ai ça pour la carte graphique.
C'est ceux de la carte graphique dont tu parles ?

 

[Dudu2]

Alors je vais faire un essai.
Mais avant, sauvegarde Macrium du disque système et point de restoration.
Mon expérience des changements de drivers est faite de mauvais souvenirs.

 

[Lu76Fer]

re
juste en passant

Merci pour la vidéo.
Ce qui est bien c'est que tu nous montres que le coef PxToPt ne change pas entre un zoom de windows à 100% et 125%.
Perso, je vais vérifier mais ce qui influence la valeur PxToPt c'est, je crois, la résolution de l'écran et il est donc normal que Dudu2 n'obtienne pas la même valeur. Je suppose qu'il n'a pas la même résolution d'écran que toi.

Rem. : Par contre ou je me suis planté c'est de croire que le nombre de point avait un rapport direct avec la taille de l'écran. Si on est obligé de se coltiner des conversions c'est parce que ces grandeurs en point concerne l'impression afin d'avoir les bonnes dimensions sur la sortie de l'imprimante.
Sinon j'ai lu que le Dot de DPI concerne les points à l'impression.

 

[patricktoulon]

Alors je vais faire un essai.
Mais avant, sauvegarde Macrium du disque système et point de restoration.
Mon expérience des changements de drivers est faite de mauvais souvenirs.

oui c'est bien les whql qu'il faut télécharger
et une fois fait et installer sert toi du panneau dispo dans l'acces rapide dans la barre des tache pas du paneau de windows
et dans l'interface tu trouvera dans un de tes panneau nvidia utiliser la gestion de nvidia ou ne pas laisser window gérer l'affichage ou quelque chose du genre qu'il faudra cocher

 

[patricktoulon]

bon a a perdu dudu là

 

[Dudu2]

Non, je suis sur une autre affaire plus urgente.

Je veux envoyer un mail via ThunderBird en ligne de commande.
Alors j'ai réussi à le composer grâce à ces infos.

Mais il n'y a pas de SEND en ligne de commande
Thunderbird does not send mail without providing a visual feedback in the style of a send button.

Alors j'utilise un script VBS pour utiliser le raccourci d'envoi sur Thunderbird (Ctrl + Entrée).

Donc j'ai 2 fichiers:
Un .bat:

echo off
"C:\Program Files\Mozilla Thunderbird\thunderbird.exe" -compose "to='xxxxxx@orange.fr',subject='Envoi automatique',body='PC Start'"
timeout 3
C:\Windows\System32\cscript.exe F:\SendKeys.vbs

et un .vbs:

Set WshShell = CreateObject("WScript.Shell")
WshShell.SendKeys "^{ENTER}"
WScript.Quit()

Mais je n'arrive pas à tout placer dans le VBS, j'ai des erreurs de syntaxe avec le WshShell.Run, ça m’énerve !

 

[patricktoulon]

re
vbs tout une histoire
a tu déjà entendu parler de wscriptargument(index)


allez tu n'es pas loin
je te donne un indice (tout est dans le VBS )
contrairement a ce que tu fait c'est a dire ouvrir thundebird et espérer avec un wshel envoyer un sendkey

 

[Dudu2]

J'y suis presque !
Me manque un Sleep qui part en erreur de syntaxe.
Je ne sais pas comment déclarer le Sleep.

 

[Dudu2]

Voilà...!
Envoyer un Mail Thunderbird par ligne de commande ?
Dudu2 a la réponse: (Edit en plus propre)

Dim ThunderbirdCompose
Dim Destinataires
Dim Sujet
Dim Texte
Dim PiecesJointes
Dim WMI
Dim Processes

'Selon l'installation de Thunderbird en 64 / 32 bits
Const ThunderbirdExe = "C:\Program Files\Mozilla Thunderbird\thunderbird.exe"
'Const ThunderbirdExe = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"

'Thunderbird / Outils / Paramètres / Rédaction / Demander confirmation lors de l'utilisation d'un raccourci clavier pour envoyer un message
Const ConfirmationEnvoi = True    'Selon la valeur du paramètre Thunderbird

'Selon la rapidité d'exécution Thunderbird
Const TemporisationComposition = 2000
Const TemporisationConfirmation = 2000
'
Destinataires = "xxxxxxxxxx@orange.fr"
Sujet = "Envoi automatique"
Texte = "PC Start"
PiecesJointes = "F:\2023-10-04-09h43m24.jpg"

'http://kb.mozillazine.org/Command_line_arguments_-_Thunderbird
ThunderbirdCompose = """" & ThunderbirdExe & """ -compose """ & _
                     "to=" & "'" & Destinataires & "'" & ",subject=" & "'" & Sujet & "'" & ",body='" & Texte & "'"
If Len(PiecesJointes) > 0 Then
    ThunderbirdCompose = ThunderbirdCompose & ",attachment=" & "'" & PiecesJointes & "'"
End If
ThunderbirdCompose = ThunderbirdCompose & """"
'            
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run ThunderbirdCompose

'Attendre l'activation de Thunderbird
Set WMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Do While 1
    Set Processes = WMI.ExecQuery ("Select * from Win32_Process Where Name = 'thunderbird.exe'")
    If Processes.count > 0 then Exit Do
    Wscript.Sleep 500
Loop

'Attendre la création du mail composé
Wscript.Sleep TemporisationComposition

'Control + Enter sur la fenêtre Thunderbird pour envoyer
WshShell.SendKeys "^{ENTER}"

'Confirmation d'envoi paramétrée
If ConfirmationEnvoi then
    'Attendre l'appartition de la fenêtre de confirmation
    Wscript.Sleep TemporisationConfirmation
    'Enter sur la  fenêtre de confirmation
    WshShell.SendKeys "{ENTER}"
End If

WScript.Quit()

Enregistrer avec l'extension .vbs