Discussion :

[Xlcro]

À la suite d'un clic droit, par défaut, Excel affiche à la position de la souris la barre de commande "Cell". Cette même barre de commande est affichée lorsque la touche Menu est enfoncée, mais cette fois, `;à la position du "caret", le trait vertical qui clignote dans la cellule sélectionnée. Désolé, mais je n'ai pas trouvé de traduction française convaincante pour "caret".

C'est exactement cette fonctionnalité que je souhaite implanter pour les menus contextuels d'une application qui sera utilisée par des personnes voyantes, mal voyantes ou aveugles, ces dernières utilisant un lecteur d'écran, par exemple JAWS ou NVDA.

Sur les feuilles où des menus contextuels sont prévus, j'ai d'abord tenté de modifier temporairement la barre de commandes "Cell", mais il ne semble pas possible de prendre complétement le contrôle de cette barre de commandes, Excel y rétablissant à la volée des items que j'y avais désactivés, notamment ceux liés au Copier/Coller.

Je me suis donc tourné vers une barre de commande personnalisée de type msoBarPopup qu'il est facile d'afficher à la position de la souris en interceptant le clic droit. Par contre, à partir du clavier, je ne parviens pas à faire afficher ce PopUp à la position du caret. Or, il s'avère qu'afficher ce menu près du point d'intérêt est primordial pour les personnes qui ont un champ visuel restreint et pour qui l'usage de la souris est difficile ou impossible.

-J'utilise Application.OnKey pour associer la macro d'affichage de mon menus contextuel à la touche Alt + FlècheBas. Lorsque la touche est enfoncée, la méthode ShowPopup de l'objet CommandBar affiche la barre de commandes à la position de la souris, ce qui est normal lorsqu'on ne spécifie pas un endroit particulier. Pour afficher à la position du caret, il faut préciser sa position sur l'écran. Les coordonnées du caret peuvent être obtenues de l'APi getcaretpos. Elles sont en pixels, mais relatives au coin supérieur gauche de la grille Excel. Pour qu'elles soient utilisables par ShowPopUp, il faut les corriger pour qu'elles s'expriment par rapport au coin supérieur gauche de l'écran. Le problème est donc maintenant de déterminer les coordonnées d'écran absolues en pixels du coin supérieur gauche de la grille Excel.

En 2017, un fil de discussion intitulé "Positionner-curseur-cellule-selectee" à traité de ce problème. J'ai lu avec grand intérêt une bonne partie des 56 pages de cette discussion, mais il m'a été impossible de retracer le code final permettant de déterminer les coordonnées d'écran du coin supérieur gauche de la grille Excel, ou, alternativement, celles d'un point arbitraire d'une cellule. Ce code existe-t-il et, le cas échéant, où puis-je le trouver ?
À défaut de connaître la position absolue de la grille Excel, on connaît celle de l'application. Dans le code suivant, c'est ce référentiel que l'API ClientToScreen utilisera pour corriger partiellement les coordonnées retournées par getcaretpos. Le décalage horizontal et vertical par rapport au caret est sans doute entièrement dû aux dimensions des structures précédant la grille Excel. Une autre piste serait de réduire ce décalage en tenant compte de la taille de ces objets.

Auriez-vous des suggestions pour trouver une solution à ce problème.
Merci à l'avance.

Pour expérimenter ce code, tout mettre dans un module standard, exécuter PrepareMenuContextuel, se déplacer vers une cellule quelconque puis faire ALT + FlècheBas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
 
Option Explicit
 
Private Type POINTAPI :  x As Long : y As Long : End Type
Private Declare PtrSafe  Function GetCaretPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe  Function ClientToScreen Lib "user32.dll" ( _
   ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Dim PositionCaret As POINTAPI
 
Sub PrepareMenuContextuel()
Dim CB As CommandBar, CBC As CommandBarControl
On Error Resume Next
Application.CommandBars("RegDon").Delete
On Error GoTo 0
Application.OnKey "%{DOWN}", "AfficherMenuContextuel"
Set CB = Application.CommandBars.Add( _
   Name:="RegDon", Position:=msoBarPopup, Temporary:=True)
Set CBC = CB.Controls.Add(Type:=msoControlButton, before:=1, temporary:=True)
CBC.BeginGroup = True
CBC.Style = msoButtonCaption
CBC.Caption = "Premier choix"
CBC.OnAction = "Choix_1"
CBC.Enabled = True
'
Set CBC = CB.Controls.Add(Type:=msoControlButton, before:=2, temporary:=True)
CBC.BeginGroup = True
CBC.Style = msoButtonCaption
CBC.Caption = "Deuxième choix"
CBC.OnAction = "Choix_2"
CBC.Enabled = True
Set CBC = Nothing
Set CB = Nothing
End Sub
 
Sub AfficherMenuContextuel()
Dim CX As Variant, CY As Variant
Call GetCaretPos(PositionCaret)
ClientToScreen Application.hwnd, PositionCaret
CX = PositionCaret.X
CY = PositionCaret.Y
Application.CommandBars("RegDon").ShowPopup CX,CY
' MsgBox "Fenêtre  Popup " & CommandBars("RegDon").Left & " " & CommandBars("RegDon").Top
End Sub
Sub choix_1()
MsgBox "(Choix 1) Position de la barre de commande" & vbCRLF _
   & "X = " & PositionCaret.X & " Y = " & PositionCaret.Y
End Sub
 
Sub choix_2()
MsgBox "(Choix 2) Position de la barre de commande" & vbCRLF _
   & "X = " & PositionCaret.X & " Y = " & PositionCaret.Y
End Sub

[Xlcro]

Pour rappel, l'objectif est d'ouvrir au clavier un menu contextuel personnalisé, à proximité de la cellule active, donc sans avoir recours à la souris. Après expérimentations, je réalise que la chose est plus simple à réaliser qu'il n'y paraissait et qu'on peut y parvenir sans avoir recours aux API de Windows.

Pour afficher un PopUp à un endroit donné, disons le coin supérieur gauche d'une cellule quelconque, la méthode ShowPopup de l'objet CommandBar exige qu'on lui précise en pixels les coordonnées d'écran de ce point. On y parvient en activant la cellule cible, pour qu'elle devienne visible, et en utilisant comme suit l'objet ActiveWindow.ActivePane :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
ActiveSheet.Cells(150,32).Activate ' Choix arbitraire
Dim CX As Variant, CY As Variant
With ActiveWindow.ActivePane
   CX = .PointsToScreenPixelsX(ActiveCell.Left)
   CY = .PointsToScreenPixelsY(ActiveCell.Top)
End With
Application.CommandBars("MaBarre").ShowPopup CX, CY

La barre de commande doit être de type msoBarPopup, sinon la méthode ShowPopup échouera. Si les coordonnées x et y ne permettent pas d'afficher la totalité du menu contextuel, elles seront modifiées pour que le menu devienne entièrement visible.

Tout semble fonctionner correctement, peu importe le zoom appliqué ou la position de la fenêtre Excel sur l'écran. Si vous avez un moment pour expérimenter le code fourni plus loin, vos commentaires seraient appréciés, cela permettrait de vérifier si la méthode est valable dans tous les environnements.

Les valeurs retournées par PointsToScreenPixelsX et PointsToScreenPixelsy peuvent être confondantes. Pour les interpréter correctement, il faut savoir que ces fonctions ne font pas seulement une conversion entre les unités "points" et les unités "pixels". Elles opèrent également un changement de référentiel, la grille Excel et la grille de l'objet ActivePane n'ayant pas la même origine.

Sur la grille Excel, les coordonnées Left et Top d'une cellule sont exprimées en points, et mesurent l'éloignement de ce point par rapport au coin supérieur gauche de la cellule a1, qui est le point (0,0). Ces coordonnées ne sont donc jamais négatives. Pour le référentiel ActivePane, l'origine est plutôt le coin supérieur gauche de l'écran. Les coordonnées retournées par les méthodes PointsToScreenPixelsX/y précisent en pixels l'éloignement relatif d'un point par rapport à cette origine. Il en découle qu'un pixel situé à Gauche de cette origine aura une abscisse négative, de même qu'Un point situé au -dessus aura une ordonnée négative.

Il faut également noter que les défilements horizontal ou vertical de l'écran n'affectent pas le système de coordonnées de la grille Excel. Par contre, pour le référentiel ActivePane, à chaque fois que l'écran défile, tous les points se déplacent par rapport à l'origine, de sorte que toutes leurs coordonnées changent.

L'utilisation de l'objet ActiveWindow.ActivePane de cette manière, pourrait s'avéré utile partout où la connaissance des coordonnées d'écran est nécessaire. Dans certains cas, il peut être justifié de déplacer automatiquement le pointeur de la souris sur une cellule donnée. L'opération devient triviale en utilisant l'API SetCursorPos avec les coordonnées obtenues de l'objet ActivePane.

Le code suivant illustre l'affichage d'un popUp au coin supérieur gauche d'une cellule quelconque. Tout mettre dans un module standard, puis exécuter la macro PrepareMenuContextuel. Se déplacer vers une cellule quelconque et faire ALT + FlècheBas . Lorsque le menu apparaîtra, il affichera les coordonnées en points et en pixels de la cellule active. Si vous activez une optionde de menu, un MsgBox confirmera les coordonnées effective du PopUp.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
Option Explicit
 
Sub PrepareMenuContextuel()
Dim CB As CommandBar, CBC As CommandBarControl
Application.OnKey "%{DOWN}", "AfficherMenuContextuel"
On Error Resume Next
Application.CommandBars("MaBarre").Delete
On Error GoTo 0
Set CB = Application.CommandBars.Add( _
   Name:="MaBarre", Position:=msoBarPopup, temporary:=True)
Set CBC = CB.Controls.Add(Type:=msoControlButton, before:=1, temporary:=True)
CBC.Style = msoButtonCaption
CBC.Caption = "Option 1"
CBC.OnAction = "AuTravail"
'
Set CBC = CB.Controls.Add(Type:=msoControlButton, before:=2, temporary:=True)
CBC.Style = msoButtonCaption
CBC.Caption = "Option 2"
CBC.OnAction = "AuTravail"
Set CBC = Nothing
Set CB = Nothing
End Sub
Sub AfficherMenuContextuel()
' Afficher le menu contextuel au coin
' supérieur gauche de la cellule active
Dim CX As Variant, CY As Variant
With ActiveWindow.ActivePane
   CX = .PointsToScreenPixelsX(ActiveCell.Left)
   CY = .PointsToScreenPixelsY(ActiveCell.Top)
End With
'
CommandBars("MaBarre").Controls(1).Caption = _
   "Coordonnées en points (" _
   & ActiveCell.Left & "," & Activecell.Top & ")"
CommandBars("MaBarre").Controls(2).Caption = _
   "Coordonnées en pixels (" & CX & "," & CY & ")"
'
Application.CommandBars("MaBarre").ShowPopup CX, CY
'
End Sub
Sub AuTravail()
With CommandBars("MaBarre")
   MsgBox "Coordonnées effectives du Popup (" _
      & .Left & "," & .Top & ")"
End With
End Sub