XLS : Evènements souris 'click' sur la grille & astuces

[Lu76Fer]

Bonjour aux vacanciers, les autres retournez au turbin 😄,

Cet article vise d'abord ceux qui aiment créer des petits jeux Excel mais aussi pour tout ceux qui apprécient de soigner l'ergonomie de leur interface et enfin tous les codeurs en recherche d'astuces techniques. Ici, je n'utilise pas de fonction système mais seulement du code standard et les outils Excel.​

Création de l'évènement MouseClic
Feuille "Test1" du fichier joint

A partir d'un évènement d'une feuille SelectionChange, il est possible de créer un évènement clic gauche sur la grille et à partir de BeforeRightClick un évènement clic droit sur la grille, même s'il faut contourner certaines limites et en accepter d'autres ...​

En effet, le clic droit sur une cellule génère tout d'abord un évènement SelectionChange puis successivement BeforeRightClick. Il est donc nécessaire de pouvoir distinguer les deux sans quoi un évènement BeforeRightClick génèrera toujours un évènement SelectionChange au préalable !​

La solution proposée consiste à différer l'appel à un pseudo évènement MouseClic qui permet de déterminer s'il s'agit d'un clic gauche ou droit à partir d'une variable de module RightClic positionné sur Vrai dans BeforeRightClick. Voici le code pour une feuille renommée S_Test1 dans l'explorateur de projet sous VBE:​

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

⚠️ il est possible qu'en ajoutant une feuille puis la renommant que celle-ci ne soit pas reconnue ! Dans ce cas sauvegardez et rouvrir le classeur, il s'agit d'un défaut d'initialisation.

Les évènements se déclenchent dans cette ordre sur un clic droit :

1. SelectionChange (Ajout de l'évènement MouseClic via OnTime)
2. BeforeRightClick (RightClic = True, Cancel = True empêche l'affichage du menu contextuel)
3. MouseClic (Si RightClic = True Alors Clic Droit Sinon Clic Gauche)

En faite, la méthode OnTime permet d'ajouter dans une file d'attente l'appel à la procédure MouseClic comme un évènement à traiter (Now=Immédiatement), du coup chacune des procédures ci-dessus est exécutée séquentiellement. Pour le clic gauche, c'est pareil mais sans passer par BeforeRightClick.​

A noté que les procédures RightAction() et LeftAction() sur un projet pourront être renommées puis positionnées dans un module de code.​

Dans cette illustration on remarquera qu'il existe certaines limitations contraintes par le déclenchement de l'évènement SelectionChange :

• La première c'est qu'il ne s'effectue que lorsque l'on relâche le bouton contrairement au clic droit qui se déclenche "tout de suite" (position pressé). Cela est propre à cet évènement qui ne permet pas seulement de sélectionner une cellule mais aussi une zone. Il faut faire avec ...​
• La deuxième c'est qu'il ne se déclenche pas si la zone que l'on active est déjà active ! Sur la deuxième partie, on définira un modèle ou seule une zone sera concernée par les évènements Clic souris et on repositionnera chaque fois la cellule active en dehors de cette zone de façon à pouvoir cliquer plusieurs fois sur la même cellule.​

Illustration à partir d'un Jeu de Plateau sans enjeu
Feuille "PlateauDeJeu" du fichier joint

Pour réaliser un jeu de plateau dans un système aussi ouvert qu'un tableur Excel, il faut brider certaines interactions utilisateur pour éviter que l'utilisateur ne puisse détraquer votre jeu par erreur. Personnellement, laisser la possibilité à l'utilisateur de changer l'apparence n'est pas un problème et par expérience l'utilisation de protection sur la feuille est très complexe à coder avec le risque d'avoir un blocage à l'ouverture ... Je vais donc vous proposer des techniques simples pour protéger l'essentiel sans contraindre le joueur.​

La sélection permet par défaut d'encadrer une zone et une simple suppression <Suppr>, détruira tout le texte de la zone. Annuler une opération est complexe à gérer,
il est préférable d'empêcher une sélection de plusieurs cellules qui n'a pas lieu d'être pour un jeu de plateau !​

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Cells.Count > 1 Then If IsNull(Target.MergeCells) Or Not (Target.MergeCells) Then ActiveCell.Select
End Sub

Ce code permet de ramener la sélection de plusieurs cellules vers la cellule active et ne "confond pas" une cellule fusionnée avec plusieurs cellules.

Ensuite le code de votre jeu peu générer des évènements SelectionChange en utilisant par exemple le collage sur une zone ou la méthode Select pour modifier des cellules (💩💩), il faut donc mieux verrouiller les évènements utilisateurs. Pour cela, il faut que toutes vos interactions avec l'utilisateur passe par une macro présente dans le module de Feuille et avant chaque appel à une fonction de votre code vous pourrez gérer le verrou. Il existe la propriété Application.EnableEvents que je déconseille car elle s'applique de façon beaucoup trop large et peut engendrer un plantage de votre Session.​

Voici un modèle avec l'utilisation d'une variable LockUserEvts qui pourra être déclaré en variable public au niveau d'un module utilisateur pour avoir une portée (Scope) plus large (toutes les feuilles du classeur) ou simplement dans la feuille :​

'Module Utilisateur
Public LockUserEvts As Boolean

'Module de Feuille
Sub BtnAction()    'Exemple d'une macro associée à un bouton
    LockUserEvts = True
    Call Traitement()
    LockUserEvts = False
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If LockUserEvts Then Exit Sub
' . . .

A cette variable il est nécessaire d'ajouter une variable interne à la feuille PrvAC qui mémorisera la position de la cellule précédemment sélectionnée pour pouvoir revenir sur la position précédente lorsque l'on clic sur le plateau et voici le code global :​

'[Gameboard], [BtnClear], [BtnRandom] : Named areas (Range("Gameboard") equivalent : [Gameboard])
Dim LockUserEvts As Boolean, RightClic As Boolean '*** Peuvent être déplacées en variable public dans un module utilisateur ***
Private PrvAC As Range  'Previous Active Cell

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If LockUserEvts Then Exit Sub
   'If Target.Cells.Count > 1 Then If IsNull(Target.MergeCells) Or Not (Target.MergeCells) Then ActiveCell.Select: Exit Sub   'Replace selection with active cell
   If Target.Cells.Count > 1 Then If IsNull(Target.MergeCells) Or Not (Target.MergeCells) Then GoBack: Exit Sub   'Selection canceled
   If Not (Intersect([Gameboard], ActiveCell) Is Nothing) Then _
      Application.OnTime Now, "S_GameBoard.MouseClic": Exit Sub
   If Not (Intersect([BtnClear], ActiveCell) Is Nothing) Then Application.OnTime Now, "'S_GameBoard.BtnAction 1'": Exit Sub
   If Not (Intersect([BtnRandom], ActiveCell) Is Nothing) Then Application.OnTime Now, "'S_GameBoard.BtnAction 2'": Exit Sub
   Set PrvAC = ActiveCell
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   If LockUserEvts Then Exit Sub
   If Not (Intersect([Gameboard], ActiveCell) Is Nothing) Then RightClic = True
   Cancel = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)   'Lock Double Click
   Cancel = True
End Sub

'Pseudo grid event : 'clic' on mouse
Sub MouseClic()
   LockUserEvts = True
   If RightClic Then 'Right Clic(Event ButtonDown)
      RightAction
      RightClic = False
   Else              'Clic(Event ButtonUp)
      LeftAction
   End If
   LockUserEvts = False
   GoBack   'After action
End Sub

Sub GoBack()   'Goto previous Active Cell
   Application.Goto IIf(PrvAC Is Nothing, [A1], PrvAC)
End Sub

Sub BtnAction(nb As Integer)    'Simulate form button. I named : "CellButton"
   LockUserEvts = True
   GoBack   'Before action
   On nb GoSub ClearGameboard, FillRandomCases
   LockUserEvts = False
Exit Sub
ClearGameboard: ClearGameboard: Return
FillRandomCases: FillRandomCases: Return
End Sub

Sub LeftAction()  'Fill case in red
   ActiveCell.Interior.ColorIndex = 3
End Sub

Sub RightAction() 'Fill case in blue
   ActiveCell.Interior.ColorIndex = 5
End Sub

⚠️Il est important de reprendre la même condition dans BeforeRightClick que dans SelectionChange, à savoir : If Not (Intersect([Gameboard], ActiveCell) Is Nothing)

Dans SelectionChange, j'ai ajouté des pseudo-boutons [BtnClear] et [BtnRandom] pour avoir des petites fonctions en plus pour interragir avec le plateau. J'utilise la méthode Intersect() pour savoir si l'utilisateur à cliqué sur un bouton ou le plateau mais il y a d'autres façon de coder cela et si on clic en dehors de ces zones, il faut affecter la position actuelle ActiveCell dans PrvAC. A noté qu'évidemment on verrouille les évènements utilisateurs pour les procédures différées BtnAction() et MouseClic.​

La procédure GoBack() permet de revenir sur la position précédente ou la cellule [A1] si elle n'est pas été initialisée. Ici j'utilise la méthode Goto() car les méthodes Activate() ou Select() peuvent engendrer des déplacements ératiques avec les touches fléchées si on a des cellules fusionnées.​

On ajoute l'évènement BeforeDoubleClick pour le bloqué et éviter de se retrouver éjecté dans une autre cellule en mode saisie : Cancel = True. Il n'est pas possible de le gérer dans MouseClic car l'évènement BeforeDoubleClick se déclenche après...​

🤖 Faites un petit test pour vérifier que tout fonctionne correctement ... Notamment, vous pouvez vous amuser à essayer de traverser le plateau avec les touches fléchées directionnelle du clavier ...

Du coup vous pourriez constater que des cellules en dehors du plateau se retrouvent colorées en rouge ! Vous avez peut-être déjà deviné d'où peut venir le problème. Nous allons voir dans une 3ème partie comment corriger cela en basculant sur la dernière feuille.​

⚠️ Mon conseil : si vous désirez coder quelque chose de technique au sein d'un projet, adopté la méthode scientifique et prenez le temps de partir d'un classeur vierge pour bien cibler votre sujet sans qu'il soit pollué par le code de votre projet et par la même sans polluer votre projet.

Correction et finitions
Feuille "SuperPlateau" du fichier joint

Pour comprendre d'où vient l'anomalie, il faut regarder comment se déclenchent les évènements lorsque l'on presse en continue une flèche de direction :​

SelectionChange->SelectionChange->SelectionChange->MouseClick->MouseClick->MouseClick

SelectionChange passe en priorité et du coup ActiveCell ne correspond plus à la bonne cellule quand le 1er MouseClick s'exécute. Il faut donc passer en paramètre la position ActiveCell et on prendra l'adresse texte car il n'est pas possible de passer un objet par une commande de script :​

'Dans la procédure : SelectionChange
   Application.OnTime Now, "S_GameBoard.MouseClic"
' * * * D E V I E N T * * * (Encadré avec ')
   Application.OnTime Now, "'S_SuperBoard.MouseClic """ & ActiveCell.Address & """'"
'Puis conversion dans MouseClic(£sAC as String)
    Action Range(£sAC)   'Il ne faut plus utiliser ActiveCell ou Selection

Pour que mon jeu de plateau ressemble d'avantage à un jeu je vais lui rajouter à minima un titre et un fond d'écran :

Concernant le titre, il est préférable de le protéger pour qu'il ne soit pas accidentellement changé. Pour cela, j'utilise dans le menu Données, la Validation des données. Dans l'onglet Option, choisir Personnalisé puis j'entre la Formule FAUX pour tout interdire. Ensuite je personnalise le message d'erreur dans l'onglet Alerte d'erreur.​

🎁 Pour changer le fond d'écran, j'ai un soucis dans l'interface, du coup j'utilise la fonction SetImgBckGrd présente dans le module Tools du classeur ci-joint.

En codant sous Excel, comme tout le monde n'a pas la même version, il faut être soucieux de la compatibilité de son code. Il y a des méthodes qui restent présentes dans les versions plus récentes par soucis de compatibilité ascendante mais qui peuvent présenter des problèmes et qu'il faudrait mieux éviter : c'est le cas pour la méthode ScreenUpdating qui peut provoquer des ralentissements croissants et persistant au cour de la session.​

Par contre, elle est très efficace sur les anciennes versions et du coup je propose une procédure qui s'utilise de la même façon et tient compte de la version que vous utilisez :​

Sub RefreshScreen(isActive As Boolean)
Static graphicsMotorType%    'Old Graphics Motor for version < 15 (before Excel 2013)
   If graphicsMotorType = 0 Then graphicsMotorType = IIf(CInt(Replace(Application.version, ".", ",")) < 15, 1, 2)
   If graphicsMotorType = 2 Then Application.ScreenUpdating = isActive
   If isActive Then DoEvents
End Sub

'Utilisation :
RefreshScreen False
'Code ...
RefreshScreen True

Souvent on utilise, pour créer un jeu, une feuille cachée et il faut bien faire attention à la valeur affectée à la propriété Visible. Si on la change manuellement dans l'éditeur VBE par xlSheetHidden, elle bascule sur xlSheetVeryHidden ! Il faut alors sélectionner à nouveau la feuille et insister en la positionnant sur xlSheetHidden ! Si vous ne le saviez pas c'est très important et cela peut vous éviter de mystérieux plantage de Session. La feuille sera cachée mais vous pourrez y accéder par le code sans changer sa visibilité (si la feuille est nommé F_HideSheet) : F_HideSheet.Range("A1") = "Feuille cachée". Il faut bannir xlSheetVeryHidden !!​

Conclusion

Il est vrai que mon Jeu de Plateau serait prévu pour jouer à la souris mais il faut qu'il soit assez robuste pour supporter une mauvaise manipulation d'un joueur ...​

Par contre, il est vain d'essayer de le rendre intouchable par un tas de protection car si l'utilisateur fait des transformations et le rend inutilisable via les commandes du menu, dans ce cas on peut considérer que c'est l'utilisateur qui saborde lui-même son jeu. C'est ce qui me plaît dans Excel, créer des prototypes fonctionnelles et instantanément utilisables. Une appli à la fois libre et sous-contrôle !​

 

[Lu76Fer]

Il reste encore une possibilité d'améliorer le code en empêchant que le déplacement au clavier ne déclenche un évènement MouseClic. Je sais que c'est sans doute compliqué à coder c'est pour cela que j'ai fait appel à tous par la question ci-dessous :
XLS : comment savoir si un évènement SelectionChange est provoqué par le clavier ou la souris ?

Si vous êtes inspiré et aimé les petits challenges, suivez le lien ci-dessus.

 

[Lu76Fer]

💾 : GameBoardTemplate.xlsm

Re : bilan du challenge ci-dessus
Voir les résultats obtenus : Modèles du Jeu de Plateau pour chaque solution proposée

​

De mon côté, j'ai pu faire le bilan et j'ai créer un modèle basique pour jeu de plateau avec une gestion à la souris que je met à disposition ici pour tous ceux qui préfèrent partir d'un premier socle. Je vais aussi expliquer toutes les améliorations apportées par rapport au modèle présenté dans le fichier joint à ce petit tutoriel qui au départ était une solution technique pour créer des évènements click gauche et click droit.​

🎁 Cette version est beaucoup plus robuste et protégé que le modèle basique et bénéficie de petites corrections.​

Pour distinguer qu'un évènement SelectionChange est déclenché plutôt par le clavier que la souris, j'ai dû faire appel à une fonction système et j'ai créé la fonction IsKeyboardMove pour savoir si l'évènement était déclenché par un déplacement au clavier :​

#If VBA7 Then
   Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
   Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

'Touches directionnelles, PageDown, PageUp, Home ou Tab (Enter ou Return ignorés) pressé
Function IsKeyboardMove() As Boolean
   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

Noté que j'aurai pu simplement détecter le click gauche, vbKeyLButton, mais pour rappel, l'évènement SelectionChange ne se déclenche que lorsque l'on relâche le bouton gauche et n'est donc pas détectable par la fonction système GetAsyncKeyState. Par contre, un déplacement au clavier déclenche SelectionChange dès qu'on presse le bouton (en position basse).

Cela fonctionne mais en buttant avec le clavier sur les boutons ou le plateau environ 1 fois sur cent, la pression de la touche au clavier n'était pas détectée et cela déclenchait l'action car considéré comme un click gauche de la souris. C'est ma version présentée dans les résultats du petit challenge.​

Pour corriger ma version, j'ai changé le comportement de l'application de façon à ce qu'un déplacement au clavier vers le plateau ou vers un bouton le traverse plutôt qu'elle ne se bloque avec cette fonction ajoutée au module utilisateur S_GameBoard :​

'Zone {£area} à traverser sur la feuille Active comportant la variable nommée [AdrPrvAC]
Sub Cross(£area As Range)
Dim iRow%, iCol%, maxRow%, maxCol%, £PrvAC As Range
   Set £PrvAC = Range([AdrPrvAC])
   maxRow = £area.Row + £area.Rows.Count - 1: maxCol = £area.Column + £area.Columns.Count - 1
   iRow = (£PrvAC.Row < £area.Row) - (£PrvAC.Row > maxRow)
   iCol = (£PrvAC.Column < £area.Column) - (£PrvAC.Row > maxRow)
   If iRow Then iRow = IIf(iRow = -1, maxRow + 1, £area.Row - 1): iCol = £PrvAC.Column Else _
      iCol = IIf(iCol = -1, maxCol + 1, £area.Column - 1): iRow = £PrvAC.Row
   Application.Goto Cells(iRow, iCol)
End Sub

​

En testant l'application, j'ai aussi constaté qu'en tapant du texte tout en se déplaçant, on pouvait changer le nom des boutons et j'ai donc changé ma zone de Validation des données pour l'élargir à l'ensemble des cellules de la feuille. A ce propos, dans l'onglet Option -> Personnalisé puis l'option Ignorer si vide peut être décoché mais cela ne semble rien changer. Lorsque l'on utilise la touche Supprime, cela supprime le texte sans vergogne !!​

Il faut donc ajouté l'évènement Worksheet_Change et annuler l'effet de la suppression, le plus efficace étant la méthode Undo :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next 'Evite une erreur de conflit avec  la Validation des données
   If LockUserEvts Then Exit Sub
   If ActiveCell = "" Then LockUserEvts = True: Application.Undo: LockUserEvts = False 'Protection on deletion
End Sub

Pour protéger d'un copier-coller qui pourrait être désastreux pour le bon fonctionnement du jeu, voici une ligne à rajouter dans SelectionChange après le contrôle de la zone Sélectionnée ainsi que dans le module ThisWorkbook, contre un collage depuis un autre classeur de la même session :​

   '<Code>
   If Application.CutCopyMode Then Application.CutCopyMode = False   'Disable Copy-Paste
   '<Code>
'Dans ThisWorkbook :
Private Sub Workbook_Activate()
   If Application.CutCopyMode Then Application.CutCopyMode = False   'Disable Copy-Paste
End Sub

§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
⚠️ Les astuces de @job75 :

• Remplacer Now par 1 pour les appels différés immédiat avec Application.OnTime 1, "MaFonction"
• Plus important, utiliser la collection Names pour stocker des variables persistantes ce qui permet de fermer le classeur et de revenir dessus tout en conservant ses variables de noms.

Voici comment l'utiliser pour sauver l'adresse d'une cellule :

'Créer le nom au départ (Une seule fois)
S_GameBoard.Names.Add "AdrPrvAC", ActiveCell.Address

'Lire la valeur
Debug.Print S_GameBoard.[AdrPrvAC]

'Ecrire la valeur avec la cellule active
S_GameBoard.Names("AdrPrvAC").Value = ActiveCell.Address

'Convertir l'adresse en objet Range
Set £PrvAC = S_GameBoard.Range([AdrPrvAC])

§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§

J'ai donc remplacé dans le module S_GameBoard la référence objet du module £PrvAC par la variable de nom [AdrPrvAC] et du coup pas besoin de réinitialiser la valeur au moment de l'ouverture du classeur; la donnée est persistante.​

​

Enfin, j'ai ajouté la fonction système GetTickCount pour ajouter une animation sur les boutons. Les fonctions appelé par les boutons renvoie désormais un booléen pour signifier que l'opération est valide (Vrai) ou pas (Faux). Ce qui provoque temporairement et respectivement le changement de couleur du bouton en Vert vif ou Rouge. Voir les fonctions ValidEffect, RestoreRangeColor et Wait dans le module Tools. Une bannière permet aussi de signaler l'évènement.​

Merci à ceux qui sont arrivés jusque là​

 

[Lu76Fer]

Re : petit correctif après livraison

Après avoir un peu jouer avec le modèle j'ai vu que la touche Return ou Entrée pouvait déclencher l'action d'un bouton de la même façon que le click souris, j'ai donc modifié la fonction IsKeyboardMove() dans le module Tools :

'Check if a movement key is pressed (KeyDown) (Directional arrows, PageDown, PageUp, Home, Tab, Enter or Return)
Function IsKeyboardMove() As Boolean
   IsKeyboardMove = (GetAsyncKeyState(vbKeyUp) Or GetAsyncKeyState(vbKeyDown) Or GetAsyncKeyState(vbKeyLeft) Or _
      GetAsyncKeyState(vbKeyRight) Or GetAsyncKeyState(vbKeyPageUp) Or GetAsyncKeyState(vbKeyPageDown) Or _
      GetAsyncKeyState(vbKeyHome) Or GetAsyncKeyState(vbKeyTab) Or GetAsyncKeyState(vbKeyReturn)) < 0
End Function