XL 2016 XLS : comment savoir si un évènement SelectionChange est provoqué par le clavier ou la souris ?

[Lu76Fer]

Bonjour vous tous !

Je souhaite pouvoir distinguer si un évènement Worksheet_SelectionChange est déclenché plutôt par les touches fléchées que par un Click de souris pour amener un élément supplémentaire à mon petit Tuto pour développer un jeu : XLS : Evènements souris 'click' sur la grille & astuces.

Voici un petit bout de code simple pour démarrer :

Dim RightClic As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Application.OnTime Now, "S_Test1.MouseClic"
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   RightClic = True
   Cancel = True
End Sub

'Pseudo grid event : 'clic' on mouse
Sub MouseClic()
   If RightClic Then
      RightAction
      RightClic = False
   Else
      LeftAction
   End If
End Sub

Sub RightAction()
   ActiveCell = "Droit"
End Sub

Sub LeftAction()
   ActiveCell = "Gauche"
End Sub

Merci d'avance 😉

 

[Lu76Fer]

L'expression Application.OnKey "{UP}" redonne à la touche HAUT son fonctionnement normal.

Il faut donc relancer ensuite la macro Workbook_Open mais seulement après exécution du SendKeys.

Par contre je trouve ce code un peu lourd 🚛 :

Me.Names.Add "Touche", True

Une variable dans le module suffit je pense.

J'ai testé en ouvrant mon application Sélecteur de couleur dans la même session et même avec la version avec SendKeys les touches Haut, Bas, Gauche, Droite ne fonctionne plus jusqu'à ce que je désactive la redéfinition des touches.
Le code est géniale mais il peut parasiter les autres applications déjà ouvertes ...

 

[job75]

Par contre je trouve ce code un peu lourd 🚛 :

Me.Names.Add "Touche", True

Une variable dans le module suffit je pense.

Oui mais il faut définir la variable Public Touche As Boolean dans un Module Standard (Module1).

Avec un nom défini on évite ce module.

 

[Lu76Fer]

Encore un truc que je ne savais pas, on peut stocker une valeur dans Name sans qu'un Range lui soit associé !
Cela permet de garder la donnée en mémoire au moins tout le temps de la Session ...
Merci @job75 cela me permet de mesurer l'étendue de mon ignorance 😉

 

[Lu76Fer]

Bonjour @patricktoulon et re @job75 !

J'ai repris vos solutions sur des classeurs séparés pour les appliquer à mon modèle de base.

• Sur la solution de Patrick : cela fonctionne très bien à part le cas ou le pointeur de la souris est situé au dessus de la cellule vers laquelle on se déplace au clavier. J'ai juste adapter sa fonction pour les boutons.
• Sur la solution de Job75 : je n'arrive pas à le faire marcher correctement. Le problème c'est que l'évènement Clavier (Ex. : Gauche()) ne se déclenche pas toujours entre SelectionChange et MouseClic mais parfois avant SelectionChange.
• Ma solution basique par analyse des touches fonctionne bien mais 1 fois / 100, la position de la touche est déjà en position haute et du coup l'algo considère qu'il s'agit d'un Click souris.

Merci encore pour vos idées.

 

[patricktoulon]

re
une fois le click fait fait un setcursorpos sur

dim pos as pointapi
with activewindow.activepane
pos.x=.pointstoscreenpixelsx(activecell.offset(,1).left)
pos.y=.pointstoscreenpixelsy(activecell.top)
end with
setcursorpos pos.x,pos.y

en gros le curseur se déplace légèrement sur la droite après click
ou carement bloquer le getcursor area pendant la touche tout simplement
bref solution il y a

 

[patricktoulon]

@Lu76Fer ,@job75

ou alors on mélange les deux méthodes
je reprends le principe de @job75 dans le thisworkbook
mais j'ajoute une variable public "captemouse" (booleene)
pour éviter les fuites on pourrait se servir d'un name aussi en cas de debogage ailleurs dans l'applicatif on perd pas la last position de la variable
bref cette variable on la démarre à true à l'open
chaque touche la met à false

Public Captemouse As Boolean

Private Sub Workbook_Open()
Application.OnKey "{UP}", Me.CodeName & ".Haut"
Application.OnKey "{DOWN}", Me.CodeName & ".Bas"
Application.OnKey "{LEFT}", Me.CodeName & ".Gauche"
Application.OnKey "{RIGHT}", Me.CodeName & ".Droite"
Application.OnKey "{TAB}", Me.CodeName & ".TabDirecte"
Application.OnKey "+{TAB}", Me.CodeName & ".TabInverse"
Captemouse = True
End Sub

Sub Haut()
Captemouse = False
On Error Resume Next: ActiveCell(0).Select
End Sub

Sub Bas()
Captemouse = False
On Error Resume Next: ActiveCell(2).Select
End Sub

Sub Gauche()
Captemouse = False
On Error Resume Next: ActiveCell(1, 0).Select
End Sub

Sub Droite()
Captemouse = False
On Error Resume Next: ActiveCell(1, 2).Select
End Sub

Sub TabDirecte()
Captemouse = False
On Error Resume Next: ActiveCell(1, 2).Select
End Sub

Sub TabInverse()
Captemouse = False
On Error Resume Next: ActiveCell(1, 0).Select
End Sub

maintenant dans le selection_change
lui ne change pas

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Samecell(Target) Then [A1] = "souris" Else [A1] = "fleche"
End Sub

et ma macro dans un standard
on englobe l'action dans un if captemouse
et on la remet a true en sortie de condition

'patricktoulon
#If VBA7 Then
    Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
   #Else
    Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  #End If

Type POINTAPI
    X As Long
    Y As Long
End Type



Function Samecell(cel As Range) As Boolean
    Dim pos As POINTAPI, cello
     If ThisWorkbook.Captemouse Then
        GetCursorPos pos
        Set cello = ActiveWindow.RangeFromPoint(pos.X, pos.Y)
        If TypeName(cello) = "Range" Then
            If cel.Address = cello.Address Then Samecell = True
        End If
    End If
    ThisWorkbook.Captemouse = True
End Function

autrement dit si clic et changement de cellule "souris"
si touche et cursor ailleurs "fleche"
si touche et curseur dans la cellule sélectée "fleche"
voili voilou
le petit fichier exemple qui va bien
patrick

 

[patricktoulon]

et exactement le même sauf qu'au lieu d'une variable j'utilise un name
patrick
edit :
j'oubliais aussi
tout peut aller dans le module this workbook

 

[Lu76Fer]

@Lu76Fer ,@job75

ou alors on mélange les deux méthodes
je reprends le principe de @job75 dans le thisworkbook
mais j'ajoute une variable public "captemouse" (booleene)
pour éviter les fuites on pourrait se servir d'un name aussi en cas de debogage ailleurs dans l'applicatif on perd pas la last position de la variable
bref cette variable on la démarre à true à l'open
chaque touche la met à false

Bien vu ! Cela fonctionne.