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

Lu76Fer · 29 Juillet 2025

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 :

VB:

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 😉

patricktoulon · 30 Juillet 2025

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

patricktoulon · 29 Juillet 2025

Bonsoir @Lu76Fer
un simple un simple test activewindow.rangefrompoint sur le x et y du getcursorpos devrait te donner la même cellule si c'est fait par le click souris : cela dans le selection_change bien entendu
patrick

job75 · 29 Juillet 2025

Bonsoir à tous,

Mettez ce code dans ThisWorkbook pour détecter les touches de direction :

VB:

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"
End Sub

Sub Haut()
On Error Resume Next: ActiveCell(0).Select
MsgBox "Touche HAUT"
End Sub

Sub Bas()
On Error Resume Next: ActiveCell(2).Select
MsgBox "Touche BAS"
End Sub

Sub Gauche()
On Error Resume Next: ActiveCell(1, 0).Select
MsgBox "Touche GAUCHE"
End Sub

Sub Droite()
On Error Resume Next: ActiveCell(1, 2).Select
MsgBox "Touche Droite"
End Sub

Sub TabDirecte()
On Error Resume Next: ActiveCell(1, 2).Select
MsgBox "Touche TAB"
End Sub

Sub TabInverse()
On Error Resume Next: ActiveCell(1, 0).Select
MsgBox "Touches MAJ + TAB"
End Sub

A+

job75 · 29 Juillet 2025

Une autre solution, toujours dans ThisWorkbook :

VB:

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"
End Sub

Sub Haut()
MsgBox "Touche HAUT"
Application.OnKey "{UP}": CreateObject("WScript.Shell").SendKeys "{UP}"
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

Sub Bas()
MsgBox "Touche BAS"
Application.OnKey "{DOWN}": CreateObject("WScript.Shell").SendKeys "{DOWN}"
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

Sub Gauche()
MsgBox "Touche GAUCHE"
Application.OnKey "{LEFT}": CreateObject("WScript.Shell").SendKeys "{LEFT}":
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

Sub Droite()
MsgBox "Touche Droite"
Application.OnKey "{RIGHT}": CreateObject("WScript.Shell").SendKeys "{RIGHT}"
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

Sub TabDirecte()
MsgBox "Touche TAB"
Application.OnKey "{TAB}": CreateObject("WScript.Shell").SendKeys "{TAB}"
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

Sub TabInverse()
MsgBox "Touche MAJ + TAB"
Application.OnKey "+{TAB}": CreateObject("WScript.Shell").SendKeys "+{TAB}"
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

C'est mieux pour la touche TAB si la sélection est une plage de cellules.

patricktoulon · 29 Juillet 2025

re
@Lu76Fer ,@job75
voici la solution que j'ai suggéré plus haut
dans un module standard

VB:

'patricktoulon
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Type POINTAPI
    x As Long
    y As Long
End Type

Function Samecell(cel As Range) As Boolean
    Dim pos As POINTAPI, cello
    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 Function

dans l'event selection_change

VB:

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

un petit fichier exemple

Lu76Fer · 29 Juillet 2025

Bonsoir Patricktoulon et bonsoir Job75 !
Merci pour vos lumières, c'est brillant !! Je n'ai pas pensé à tout ça, ma préférence va à la solution de Patrick mais c'est intéressant d'avoir une solution sans faire appel à une fonction système.

Lu76Fer · 29 Juillet 2025

Merci Patrick pour le code et pour l'effort, il y a juste le cas où le pointeur se trouve au dessus de la cellule mais ce n'est qu'un détail 😉
De mon côté voici le code que j'ai produit et testé :

VB:

Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Function IsKeyboardMove() As Boolean   'vbKeyEnd (inutile)
   IsKeyboardMove = (GetAsyncKeyState(vbKeyUp) Or GetAsyncKeyState(vbKeyDown) Or _
      GetAsyncKeyState(vbKeyLeft) Or GetAsyncKeyState(vbKeyRight) Or _
      GetAsyncKeyState(vbKeyPageUp) Or GetAsyncKeyState(vbKeyPageDown) Or _
      GetAsyncKeyState(vbKeyHome) Or GetAsyncKeyState(vbKeyTab)) < 0
End Function

Cela fonctionne mais ce n'est pas parfait 1 fois sur 200 le click se déclenche ! Hélas on ne peut pas tester vbKeyLButton car selection_change se déclenche sur la position haute du bouton, contrairement aux touches.

Lu76Fer · 29 Juillet 2025

job75 à dit:
Cependant la solution de Patrick peut être facilement mise en défaut.

Sélectionnez B3, en A1 on a bien souris.

Mettez le curseur au dessus de C3 et appuyez sur la flèche DROITE => on a encore souris en A1.

Oui c'est juste du coup je peux empiler ma solution avec sa solution pour que cela soit parfait 😄

D'ici à demain, attendons que nos cerveaux trouve la solution 🧠🧠🧠

job75 · 29 Juillet 2025

Bon je remets mon post.

Cependant la solution de Patrick peut être facilement mise en défaut.

Sélectionnez B3, en A1 on a bien souris.

Mettez le curseur au dessus de C3 et appuyez sur la flèche DROITE => on a encore souris en A1.

nullosse · 30 Juillet 2025

Salut,
A voir si ce que je dis est vrai :
Si il y a un selection_change et que ce n'est ni par un click bouton droit souris, ni par une touche de direction du clavier alors cela provient d'un click gauche souris :

VB:

Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If IsKeyboardMove Then
          Debug.Print "Déplacement Clavier"
    ElseIf IsMouseRClick Then
         Debug.Print "Click Droit"
    Else
       Debug.Print "Click Gauche"
    End If
End Sub
Function IsKeyboardMove() As Boolean   'vbKeyEnd (inutile)
   IsKeyboardMove = (GetAsyncKeyState(vbKeyUp) Or GetAsyncKeyState(vbKeyDown) Or _
      GetAsyncKeyState(vbKeyLeft) Or GetAsyncKeyState(vbKeyRight) Or _
      GetAsyncKeyState(vbKeyPageUp) Or GetAsyncKeyState(vbKeyPageDown) Or _
      GetAsyncKeyState(vbKeyHome) Or GetAsyncKeyState(vbKeyTab)) < 0
End Function
Function IsMouseRClick() As Boolean
   IsMouseRClick = GetAsyncKeyState(vbKeyRButton) < 0
End Function

Nullosse

Lu76Fer · 30 Juillet 2025

nullosse à dit:
Salut,
A voir si ce que je dis est vrai :
Si il y a un selection_change et que ce n'est ni par un click bouton droit souris, ni par une touche de direction du clavier alors cela provient d'un click gauche souris :

Bonjour Nullosse !
Oui cela simplifie ma version du coup, c'est juste car le click droit peut-être détecté ainsi contrairement au click gauche.
Merci.

job75 · 30 Juillet 2025

Bonjour Lu76Fer, le forum,

Pour compléter la solution que j'ai donnée, si l'on veut avoir aussi le message "Souris", dans ThisWorkbook :

VB:

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"
End Sub

Sub Haut()
Me.Names.Add "Touche", True 'nom défini, valeur VRAI
MsgBox "Touche HAUT"
Application.OnKey "{UP}": CreateObject("WScript.Shell").SendKeys "{UP}"
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

Sub Bas()
Me.Names.Add "Touche", True
MsgBox "Touche BAS"
Application.OnKey "{DOWN}": CreateObject("WScript.Shell").SendKeys "{DOWN}"
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

Sub Gauche()
Me.Names.Add "Touche", True
MsgBox "Touche GAUCHE"
Application.OnKey "{LEFT}": CreateObject("WScript.Shell").SendKeys "{LEFT}":
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

Sub Droite()
Me.Names.Add "Touche", True
MsgBox "Touche Droite"
Application.OnKey "{RIGHT}": CreateObject("WScript.Shell").SendKeys "{RIGHT}"
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

Sub TabDirecte()
Me.Names.Add "Touche", True
MsgBox "Touche TAB"
Application.OnKey "{TAB}": CreateObject("WScript.Shell").SendKeys "{TAB}"
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

Sub TabInverse()
Me.Names.Add "Touche", True
MsgBox "Touche MAJ + TAB"
Application.OnKey "+{TAB}": CreateObject("WScript.Shell").SendKeys "+{TAB}"
Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé
End Sub

Dans la feuille :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not [Touche] Then MsgBox "Souris"
ThisWorkbook.Names.Add "Touche", False'nom défini, valeur FAUX
End Sub

A+

job75 · 30 Juillet 2025

On peut bien sûr remplacer MsgBox "Touche HAUT" par [A1] = "Touche HAUT" et MsgBox "Souris" par [A1] = "Souris".

Lu76Fer · 30 Juillet 2025

Bonjour @job75 !

Je n'ai pas compris cette ligne :

VB:

Application.OnTime 1, Me.CodeName & ".Workbook_Open" 'lancement différé

Cela permet de faire quoi ?
Le 1 c'est pour que cela se déclenche toute de suite je suppose mais pourquoi lancer Workbook_Open ?

job75 · 30 Juillet 2025

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.

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

Lu76Fer

XLDnaute Occasionnel

patricktoulon

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Lu76Fer

XLDnaute Occasionnel

Lu76Fer

XLDnaute Occasionnel

Lu76Fer

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

nullosse

XLDnaute Occasionnel

Lu76Fer

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Lu76Fer

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Discussions similaires

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

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency