Voilà le code rattaché à la feuille sur une procédure de surveillance événementielle qui nous détecte le clic sur les cellules réponses :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("F18:H19,K18:M19,F22:H23,K22:M23")) Is Nothing Then
If Not Intersect(Target, Range("F18:H19")) Is Nothing Then
If Worksheets("Questions-réponses").Cells(x, 6 + (6 * (rang - 1))) = "A" Then
MsgBox ("Bien joué ! Vous passez à la question suivante !")
rang = rang + 1
Call tirage_question(rang)
End If
End If
If Not Intersect(Target, Range("K18:M19")) Is Nothing Then
If Worksheets("Questions-réponses").Cells(x, 6 + (6 * (rang - 1))) = "B" Then
MsgBox ("Bien joué ! Vous passez à la question suivante !")
rang = rang + 1
Call tirage_question(rang)
End If
End If
If Not Intersect(Target, Range("F22:H23")) Is Nothing Then
If Worksheets("Questions-réponses").Cells(x, 6 + (6 * (rang - 1))) = "C" Then
MsgBox ("Bien joué ! Vous passez à la question suivante !")
rang = rang + 1
Call tirage_question(rang)
End If
End If
If Not Intersect(Target, Range("K22:M23")) Is Nothing Then
If Worksheets("Questions-réponses").Cells(x, 6 + (6 * (rang - 1))) = "D" Then
MsgBox ("Bien joué ! Vous passez à la question suivante !")
rang = rang + 1
Call tirage_question(rang)
End If
End If
End If
ActiveSheet.Cells(1, 1).Activate
Application.EnableEvents = True
End Sub
A chaque bonne réponse la variable rang est incrémentée de 1
cette partie de code est à modifier car seul les bonnes réponses sont gérées :
If Worksheets("Questions-réponses").Cells(x, 6 + (6 * (rang - 1))) = "C" Then
ici pour la bonne réponse C.
il reste à gérer le rang 12 avec bonne réponse (1 000 000)
ActiveSheet.Cells(1, 1).Activate
cette ligne permet "de sortir" des cellule de réponse afin de détecter le changement de sélection et vérifier si c'est une des quatre cellule de réponse.
Pour voir le code, un clic droit sur le nom de l'onglet 'Jeu"
puis "visualiser le code" et vous tomber dessus...
@ bientôt
LouReeD