Arreter un compte à rebours après Validation

[Foufoudora]

Bonjour le Forum,
Je viens vers vous après une longue période pour m'eclairer sur un sujet que je n'arrive pas à resoudre.
j'ai rajouté la macro compte à rebours retrouvée dans ce forum sur le fichier Quiz Excel (zone de téléchargement) je remercie au passage leurs auteurs.
Mon probleme est quand la personne repond à la question le compte à rebours ne s'arrete pas et m'affiche le message quand il arrive à Zero; comment puis-je faire pour que le compteur s'arrete apres validation de la réponse et se reinitialise.
je récupère pour chaque question le temps du compte à rebours (feuile Quiz colonne j)
voir fichier joint
Merci par avance
edit : excusez moi je reviens vers vous avec le bon fichier
je ne sais pas ce qui c'est passé. j'ai perdu mon fichier. je veux le refaire et je reviens vers vous. désolé.

 

[Foufoudora]

Re : Arreter un compte à rebours après Validation

Bonjour le Forum,

D'abord excusez moi de l'erreur de manipulation d'hier qui a supprime mon fichier.
Voila ci-joint mon fichier et ce que je souhaite est : quand je choisi une option puis valider, le compteur s'arrete et le message "trop Tard" ne s'affiche pas et le programme continue.
Merci pour votre comprehension
Salutations

 

[fanfan38]

Re : Arreter un compte à rebours après Validation

Bonjour
Dans le code de userform1 modifier la macro suivante
Private Sub CB_ok_Click()
If OB_1 + OB_2 + OB_3 + OB_4 = 0 Then
MsgBox "Choisir une Option"
Exit Sub
End If
MsgBox " FIN" 'userform2.Hide
Application.OnTime Now, Procedure:="maProcedure", Schedule:=False
End Sub

et dans le module 1 j'ai enlevé schedule
Application.OnTime Now + TimeValue("00:00:01"), Procedure:="maProcedure"

A+ François

 

[Foufoudora]

Re : Arreter un compte à rebours après Validation

Bonjour fanfan38,
merci de s'interesser a mon fil.
j'ai fait ce que tu m'as suggere mais malheureusement j'ai un code d'erreur
run time erreur 1004
Method 'OnTime' of object'_Application' failed
sur la ligne :
Application.OnTime Now, Procedure:="maProcedure", Schedule:=False
Maerci par avance

Salutations

 

[Foufoudora]

Re : Arreter un compte à rebours après Validation

Bonjour Le Forum,

permettez mooi de faire un petit up

Merci par avance

 

[fanfan38]

Re : Arreter un compte à rebours après Validation

Bonjour,
As tu été voir dans l'aide de ton excel: Application.OnTime

A+ François

 

[Foufoudora]

Re : Arreter un compte à rebours après Validation

Bonjour Fanfan38 et le forum,

oui j'etais voir l'aide, pas plusque tu m'as dit et mon niveau VBA tend vers Zero. j'ai declare une variable boolean etat et le code devient comme ceci et j'ai supprime le MSGBOX mais le compteur tourne toujours.

Une seule chose:je recupere le temps du compteur pour chaque question, qui se trouve dans une feuille du classeur,
par une variable compte = Sheets("Quiz").Cells(N, 10)
est-ce ca peut venir de ca ?/?

merci par avance


Sub maprocedure()
etat = True
If compte > 1 Then
UF_q.CR_q.Caption = compte & " seconds"
Else
UF_q.CR_q.Caption = compte & " second"
End If
If compte = 0 Then
Unload UF_q
Exit Sub
etat = False
End If
Application.OnTime Now + TimeValue("00:00:01"), procedure:="maProcedure", schedule:=etat
compte = compte - 1
End Sub

 

[fanfan38]

Re : Arreter un compte à rebours après Validation

Re,

Là il y a une erreur:
If compte = 0 Then

etat = False 'déplacé

Unload UF_q 'là tu sors de l'userform donc l'état doit être mis à false avant

Exit Sub 'tu sors de la procédure donc les lignes suivantes ne sont pas gérée


'etat = False à déplacer
End If
Application.OnTime Now + TimeValue("00:00:01"), procedure:="maProcedure", schedule:=etat
compte = compte - 1
End Sub[/QUOTE]

A+ François

 

[Foufoudora]

Re : Arreter un compte à rebours après Validation

Bonjour fanfan38 et le forum,

la macro est devenu comme ca si je ne me trompe pas
If compte > 1 Then
UF_q.CR_q.Caption = compte & " seconds"
Else
UF_q.CR_q.Caption = compte & " second"
End If
If compte = 0 Then
etat = False
Unload UF_q
Exit Sub
End If
Application.OnTime Now + TimeValue("00:00:01"), procedure:="maProcedure", schedule:=etat
compte = compte - 1

et dans
Private Sub CB_ok_Click()
je dois changer quelque chose

Merci pour ton aide

 

[fanfan38]

Re : Arreter un compte à rebours après Validation

J'ai ressorti un ancien ordi ayant une version plus ancienne d'excel en effet...
J'ai bien peur qu'il faut utiliser un autre systeme pour le compte à rebours...

A+ François

 

[fanfan38]

Re : Arreter un compte à rebours après Validation

Re,
Le progressbar de l'exemple ci joint pourrai peut etre t'aider...

A+ François

 

[tototiti2008]

Re : Arreter un compte à rebours après Validation

Bonjour à tous,

je n'ai pas suivi toute la progression du fil, mais ne serait il pas mieux, à chaque fois que l'on fait un Ontime avec Schedule:=True, de stocker l'heure à laquelle il a été programmé dans une variable, puis quand on voit que le compte = 0, on desactive non pas celle dans 1 seconde mais celle à la dernière heure programmée ?

du genre :

If compte > 1 Then
UF_q.CR_q.Caption = compte & " seconds"
Else
UF_q.CR_q.Caption = compte & " second"
End If
If compte = 0 Then
etat = False
Unload UF_q
Exit Sub
End If
if etat then
Heure = Now + TimeValue("00:00:01")
Application.OnTime Heure, procedure:="maProcedure", schedule:=true
compte = compte - 1
else
Application.OnTime Heure, procedure:="maProcedure", schedule:=false
end if

 

[Foufoudora]

Re : Arreter un compte à rebours après Validation

Bonjour fangfan38, tototiti2008,
D'abord merci pour votre reponse,
fanfan38 : merci pour ton fichier je veux essayer d'adapter la progress bar et je reviens vers toi.
tototiti2008 : j'ai fait les modifs comme tu as indique et malheureusement ca ne fonctionne pas car j'ai mis un Msgbox dans le module

Private Sub CB_ok_Click()
If OB_a + OB_b + OB_c = 0 Then
MsgBox "Choisir une Option."
Else
UF_q.Hide
End If
If UF_q.OB_a = True Then
Reponse = "a."
End If
If UF_q.OB_b = True Then
Reponse = "b."
End If
If UF_q.OB_c = True Then
Reponse = "c."
End If
'---- positionnement curseur
Sheets("rapport2").Unprotect ("jacques")

If Sheets("Rapport2").Cells(8, 4).Value <> "" Then
Sheets("Rapport2").Range("D8").Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Else
Range("D8").Select
End If
ActiveCell.Value = Reponse ' Reponses
MsgBox compte
End Sub

pour voir la valeur de "compte" mais malheureusement il m'affiche la valeur precedente du compte.

Merci par avance

Salutations

 

[Foufoudora]

Re : Arreter un compte à rebours après Validation

Bonjour fanfan38, tototiti2008 et le forum,

fanfan38, merci pour l'application du progressbar malheureusement je n'ai pas pu l'installer au travail, systeme de verouillage et securite oblige;

tototiti2008, merci pour la modif du macro mais ca n'a pas resolu le probleme.
j'ai mis une instruction : compte = 0 a chaque fois je valide la reponse. je ne sais pas si c'est catholique mais apparemment ca fonction.
j'aurai souhaite comprendre pourquoi l'application.ontime n'a pas fonctionne.
Merci pour vous

Salutations