Compte à rebours + compteur de points

Bonjour à tous. J'ai ici un quiz. Je voudrais si possible deux choses.

1er chose: Un compteur de point. Si je répond bien, 1 pts, sinon 0pt

2eme chose: Un compte à rebours. Si on ne répond pas avant la fin du compte à rebours (disons 5 secondes) , le joueur ne marque pas de point.

Ca me ferait vraiment plaisir

Cordialement

Dans ton module

Sub mauvais()
MsgBox ("Ton temps est écoulé")
Call QuestionSuivante
End Sub

Tu modifies cette procédure de la sorte:

Sub QuestionSuivante()
Application.EnableEvents = False
  If Range("W2") = "" Then
  Sheets("Feuil4").Select
    Sheets("Feuil4").Range("A1") = "Terminé ! Toutes les questions ont été posées"
    Exit Sub
  End If
  Range("X1").Formula = "=Feuil1!$A$" & Range("W" & Rows.Count).End(xlUp)
  Range("W" & Rows.Count).End(xlUp).ClearContents

  Range("F20") = ""
  Range("F14") = ""
  Range("F16").Select
  Application.EnableEvents = True
  Range("F16") = ""
End Sub

Module feuille 3

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F16")) Is Nothing Then
Application.OnTime Now + TimeValue("00:00:10"), "mauvais"
End If
End Sub

Rebonjour et merci du temps que tu m'a consacré. Seulement, je crains que le compte à rebours ne soit pas juste pour une question et qu'il ne se régénère pas à chaque question; si je ne dit pas de bêtises. Cordialement

Tu dis des bêtises.

En tout cas ça bug pour moi...

Je ne sais pas pourquoi !

Cordialement

Des idées ?

Encore merci