Tempo à l'ouverture

[CHRIS 57]

Bonjour à tous,

Voici mon nouveau problème :

J'aimerai qu'à l'ouverture d'un classeur une tempo se lance qui dure 10 sec.

Dans une cellule apparait le décompte.

Si l'utilisateur clique sur une touche, la tempo s'arrête

Si l'utilisateur ne fait rien, au bout des 10 sec une macro se lance.


J'ai utilisé ces macros pour faire la tempo, mais impossible de réaliser un décompte de 10 sec car ces instructions ne fonctionnent qu'avec "now" et donc compte à partir de l'heure actuelle...


' Lance la tempo

Sub MEShorloge()
CHRONO = Now + TimeValue("00:00:01")
[D9] = CHRONO ' Affiche la tempo mais avec l'heure actuelle + 1 sec


If CHRONO = CHRONO + 10 Then 'ça ça marche évidement pas
ARREThorloge
[D10] = "Chrono Stopé"
End If

Application.OnTime CHRONO, "MEShorloge", , True
End Sub


' Arrête la tempo (actuellement affecté à un bouton car impossible d'arrêter la macro automatiquement après 10 sec)

Sub ARREThorloge()
On Error GoTo FIN
Application.OnTime CHRONO, "MEShorloge", , False
FIN:
End Sub

 

[myDearFriend]

Bonsoir Chris57,


Un exemple ci-joint qui pourrait répondre à ton problème...

Dans ThisWorkbook :
Private Sub Workbook_Open()
   Application.OnKey " ", "StopChrono"
   Chrono True
End Sub

Dans un Module de code :
Dim Tempo As Date

Sub Recommence()
   Chrono True
End Sub

Sub Chrono(Optional Dep As Boolean)
Static N As Byte
   If Dep Then N = 0     'Repart de Zéro
&nbsp;&nbsp;&nbsp;If N < 11 Then
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Cells(19, 5).Value = N
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Tempo = Now + TimeValue("00:00:01")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Application.OnTime Tempo, "Chrono"
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;N = N + 1
&nbsp;&nbsp;&nbsp;End If
End Sub

Sub StopChrono()
&nbsp;&nbsp;&nbsp;On Error Resume Next
&nbsp;&nbsp;&nbsp;Application.OnTime Tempo, "Chrono", , False
&nbsp;&nbsp;&nbsp;On Error GoTo 0
End Sub


En espérant que cela puisse t'aider.

Cordialement.

Didier_mDF

 

[CHRIS 57]

Merci ! C'est exactement ce que je cherchais !