Urgent une aide pour feuille avec chrono

Le
hys56
bonjour, j'ai créé un test pour mes élèves avec ce code ( le test se ferme
au bout du temps imparti et s'enregistre)
MAIS le chrono s'arrête quand on écrit dans une cellule et qu'on n'en sort
pas comment remédier?
l'original vient de http://boisgontierjacques.free.fr/
voici le code dans un module
Dim temps
Sub majHeure()
Sheets("Accueil").[A1] = Sheets("Accueil").[A1] - 1 '
adapter
Sheets("questions1").[A1] = Sheets("Accueil").[A1]
Sheets("questions2").[A1] = Sheets("Accueil").[A1]
If Sheets("Accueil").[A1] = 0 Then
MsgBox "C'est fini"
ActiveWorkbook.Close True
Else
temps = Now + TimeValue("00:00:1")
Application.OnTime temps, "majHeure"
End If
End Sub
Sub démarrer()
[A1] = 30 ' adapter
majHeure
Sheets("questions1").Activate
End Sub
Sub auto_close()
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:úlse
End Sub
et le fichier utilisé
http://www.cijoint.fr/cij135896966805.xls

merci de votre précieuse aide.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FFO
Le #5125581
Salut à toi

Une solution peut être est de remplacer la ligne :

temps = Now + TimeValue("00:00:1")

par

temps = Application.Wait(Now + TimeValue("0:00:01"))

L'avantage est que pendant le décompte aucune saisie n'est réalisable, le
décompte ne peut être donc perturbé

Inconvénient peut être est qu'aucune action n'est possible avant la fin du
décompte

A toi de voir




bonjour, j'ai créé un test pour mes élèves avec ce code ( le test se ferme
au bout du temps imparti et s'enregistre)
MAIS le chrono s'arrête quand on écrit dans une cellule et qu'on n'en sort
pas comment remédier?
l'original vient de http://boisgontierjacques.free.fr/
voici le code dans un module
Dim temps
Sub majHeure()
Sheets("Accueil").[A1] = Sheets("Accueil").[A1] - 1 '
adapter
Sheets("questions1").[A1] = Sheets("Accueil").[A1]
Sheets("questions2").[A1] = Sheets("Accueil").[A1]
If Sheets("Accueil").[A1] = 0 Then
MsgBox "C'est fini"
ActiveWorkbook.Close True
Else
temps = Now + TimeValue("00:00:1")
Application.OnTime temps, "majHeure"
End If
End Sub
Sub démarrer()
[A1] = 30 ' adapter
majHeure
Sheets("questions1").Activate
End Sub
Sub auto_close()
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:úlse
End Sub
et le fichier utilisé
http://www.cijoint.fr/cij135896966805.xls

merci de votre précieuse aide.





hys56
Le #5125561
Bonjour et merci d'avoir tenté de m'aider
dans mon cas il faut écrire dans la cellule et le décompte doit continuer
même si on n'est pas sorti de la cellule
peut-être tester avec le fichier joint
difficile je crois?
"FFO"
Salut à toi

Une solution peut être est de remplacer la ligne :

temps = Now + TimeValue("00:00:1")

par

temps = Application.Wait(Now + TimeValue("0:00:01"))

L'avantage est que pendant le décompte aucune saisie n'est réalisable, le
décompte ne peut être donc perturbé

Inconvénient peut être est qu'aucune action n'est possible avant la fin du
décompte

A toi de voir




bonjour, j'ai créé un test pour mes élèves avec ce code ( le test se
ferme
au bout du temps imparti et s'enregistre)
MAIS le chrono s'arrête quand on écrit dans une cellule et qu'on n'en
sort
pas comment remédier?
l'original vient de http://boisgontierjacques.free.fr/
voici le code dans un module
Dim temps
Sub majHeure()
Sheets("Accueil").[A1] = Sheets("Accueil").[A1] - 1 '
adapter
Sheets("questions1").[A1] = Sheets("Accueil").[A1]
Sheets("questions2").[A1] = Sheets("Accueil").[A1]
If Sheets("Accueil").[A1] = 0 Then
MsgBox "C'est fini"
ActiveWorkbook.Close True
Else
temps = Now + TimeValue("00:00:1")
Application.OnTime temps, "majHeure"
End If
End Sub
Sub démarrer()
[A1] = 30 ' adapter
majHeure
Sheets("questions1").Activate
End Sub
Sub auto_close()
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:úlse
End Sub
et le fichier utilisé
http://www.cijoint.fr/cij135896966805.xls

merci de votre précieuse aide.







Daniel.C
Le #5125511
Bonjour.
Modifie ton code comme suit.
Le décompte est arrêté pendant l'écriture dans la cellule, mais le temps est
pris en compte et réajusté à la validation (il faut mettre les cellules A1
au format "nombre" entier) :

Dim temps, Deb, Duree
Sub majHeure()
Var = Second(Deb + Duree - Now)
Sheets("Accueil").[A1] = Second(Deb + Duree - Now) ' adapter
Sheets("questions1").[A1] = Sheets("Accueil").[A1]
Sheets("questions2").[A1] = Sheets("Accueil").[A1]
If Sheets("Accueil").[A1] <= 0 Then
MsgBox "C'est fini"
ActiveWorkbook.Close True
Else
temps = Now + TimeValue("00:00:1")
Application.OnTime temps, "majHeure"
End If
End Sub
Sub démarrer()
[A1] = 30 ' adapter
Duree = TimeSerial(0, 0, [A1])
Deb = Now
majHeure
Sheets("questions1").Activate
End Sub
Sub auto_close()
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:úlse
End Sub

Cordialement.
Daniel
"hys56"
bonjour, j'ai créé un test pour mes élèves avec ce code ( le test se ferme
au bout du temps imparti et s'enregistre)
MAIS le chrono s'arrête quand on écrit dans une cellule et qu'on n'en
sort pas comment remédier?
l'original vient de http://boisgontierjacques.free.fr/
voici le code dans un module
Dim temps
Sub majHeure()
Sheets("Accueil").[A1] = Sheets("Accueil").[A1] - 1 '
adapter
Sheets("questions1").[A1] = Sheets("Accueil").[A1]
Sheets("questions2").[A1] = Sheets("Accueil").[A1]
If Sheets("Accueil").[A1] = 0 Then
MsgBox "C'est fini"
ActiveWorkbook.Close True
Else
temps = Now + TimeValue("00:00:1")
Application.OnTime temps, "majHeure"
End If
End Sub
Sub démarrer()
[A1] = 30 ' adapter
majHeure
Sheets("questions1").Activate
End Sub
Sub auto_close()
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:úlse
End Sub
et le fichier utilisé
http://www.cijoint.fr/cij135896966805.xls

merci de votre précieuse aide.



hys56
Le #5125471
bonjour et très grand merci pour ce déblocage ça fonctionne parfaitement
bonne soirée
"Daniel.C"
Bonjour.
Modifie ton code comme suit.
Le décompte est arrêté pendant l'écriture dans la cellule, mais le temps
est pris en compte et réajusté à la validation (il faut mettre les
cellules A1 au format "nombre" entier) :

Dim temps, Deb, Duree
Sub majHeure()
Var = Second(Deb + Duree - Now)
Sheets("Accueil").[A1] = Second(Deb + Duree - Now) ' adapter
Sheets("questions1").[A1] = Sheets("Accueil").[A1]
Sheets("questions2").[A1] = Sheets("Accueil").[A1]
If Sheets("Accueil").[A1] <= 0 Then
MsgBox "C'est fini"
ActiveWorkbook.Close True
Else
temps = Now + TimeValue("00:00:1")
Application.OnTime temps, "majHeure"
End If
End Sub
Sub démarrer()
[A1] = 30 ' adapter
Duree = TimeSerial(0, 0, [A1])
Deb = Now
majHeure
Sheets("questions1").Activate
End Sub
Sub auto_close()
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:úlse
End Sub

Cordialement.
Daniel
"hys56"
bonjour, j'ai créé un test pour mes élèves avec ce code ( le test se
ferme au bout du temps imparti et s'enregistre)
MAIS le chrono s'arrête quand on écrit dans une cellule et qu'on n'en
sort pas comment remédier?
l'original vient de http://boisgontierjacques.free.fr/
voici le code dans un module
Dim temps
Sub majHeure()
Sheets("Accueil").[A1] = Sheets("Accueil").[A1] - 1 '
adapter
Sheets("questions1").[A1] = Sheets("Accueil").[A1]
Sheets("questions2").[A1] = Sheets("Accueil").[A1]
If Sheets("Accueil").[A1] = 0 Then
MsgBox "C'est fini"
ActiveWorkbook.Close True
Else
temps = Now + TimeValue("00:00:1")
Application.OnTime temps, "majHeure"
End If
End Sub
Sub démarrer()
[A1] = 30 ' adapter
majHeure
Sheets("questions1").Activate
End Sub
Sub auto_close()
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:úlse
End Sub
et le fichier utilisé
http://www.cijoint.fr/cij135896966805.xls

merci de votre précieuse aide.







hys56
Le #5125411
re mais nouveau petit pb je n'arrive pas à entrer un temps supérieur à 59
sec.commnt faire?
"Daniel.C"
Bonjour.
Modifie ton code comme suit.
Le décompte est arrêté pendant l'écriture dans la cellule, mais le temps
est pris en compte et réajusté à la validation (il faut mettre les
cellules A1 au format "nombre" entier) :

Dim temps, Deb, Duree
Sub majHeure()
Var = Second(Deb + Duree - Now)
Sheets("Accueil").[A1] = Second(Deb + Duree - Now) ' adapter
Sheets("questions1").[A1] = Sheets("Accueil").[A1]
Sheets("questions2").[A1] = Sheets("Accueil").[A1]
If Sheets("Accueil").[A1] <= 0 Then
MsgBox "C'est fini"
ActiveWorkbook.Close True
Else
temps = Now + TimeValue("00:00:1")
Application.OnTime temps, "majHeure"
End If
End Sub
Sub démarrer()
[A1] = 30 ' adapter
Duree = TimeSerial(0, 0, [A1])
Deb = Now
majHeure
Sheets("questions1").Activate
End Sub
Sub auto_close()
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:úlse
End Sub

Cordialement.
Daniel
"hys56"
bonjour, j'ai créé un test pour mes élèves avec ce code ( le test se
ferme au bout du temps imparti et s'enregistre)
MAIS le chrono s'arrête quand on écrit dans une cellule et qu'on n'en
sort pas comment remédier?
l'original vient de http://boisgontierjacques.free.fr/
voici le code dans un module
Dim temps
Sub majHeure()
Sheets("Accueil").[A1] = Sheets("Accueil").[A1] - 1 '
adapter
Sheets("questions1").[A1] = Sheets("Accueil").[A1]
Sheets("questions2").[A1] = Sheets("Accueil").[A1]
If Sheets("Accueil").[A1] = 0 Then
MsgBox "C'est fini"
ActiveWorkbook.Close True
Else
temps = Now + TimeValue("00:00:1")
Application.OnTime temps, "majHeure"
End If
End Sub
Sub démarrer()
[A1] = 30 ' adapter
majHeure
Sheets("questions1").Activate
End Sub
Sub auto_close()
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:úlse
End Sub
et le fichier utilisé
http://www.cijoint.fr/cij135896966805.xls

merci de votre précieuse aide.







Publicité
Poster une réponse
Anonyme