Code VBA chronomètre départ à un temps donné

Version imprimable

22/03/2018, 13h47
cedric150

Code VBA chronomètre départ à un temps donné

Bonjour à tous,

je souhaiterais de l'aide pour un code VBA pour une application suivante :

sur la colonne E j'indique un temps T1 (exemple : T1 = 15:30) , et dès lors que j'indique ce temps, un chronomètre se lance dans la colonne F en commençant à NOW - T1 (exemple: si j'indique dans la cellule E3 : T1 = 15H30 , et qu'il est 16h05 lorsque je rentre cette donné, le chronomètre se lance tout seul en débutant à 00:35:00)

Merci beaucoup pour votre aide
22/03/2018, 14h21
Menhir

C'est un sujet qui a déjà été traité sur ce forum et la conclusion a été que faire un chronomètre avec Excel est une mauvaise idée.
C'est un outil qui n'est pas conçu pour faire du temps réel.

Si tu veux quand même essayer, ceci pourra t'aider :
https://www.developpez.net/forums/d1...eme-vba-excel/
https://www.developpez.net/forums/d1...-chronometres/
22/03/2018, 16h29
cedric150

Merci Menhir

Mais je ne vois pas avec ma situation : commencer à un moment donner le chronomètre(chronomètre qui commence à 00:35:00 par ex), et non pas dès la valeur 00:00::00
22/03/2018, 17h48
Invité

Bonjour,

Quand entends tu par chronomètre?

Un truc comme ça?

https://www.developpez.net/forums/d1.../#post10006763

Pour l'instant j'ai pas trouvé la solution je cherche mais pas beaucoup le temps.
22/03/2018, 18h24
kiki29

Salut, à tout hasard : Chronomètres
22/03/2018, 21h34
cedric150

Un chronomètre : un temps qui défile seconde par seconde

Et dans ma situation, je souhaite qu'il commence à un temps calculé. Si je rentre un horaire dans une cellule (16:00 par exemple) et qu'il est 16h30 quand je rentre cet horaire, le chronomètre se lance alors à partir de 00:30:00 et defile secondes par secondes.

C'est si dur que ça ?

Je suis arrivé à faire un fichier avec un chrono qui se lance quand je remplie une cellule mais impossible de lancer à partir d'un temps donné
22/03/2018, 21h45
unparia

Bonjour

Citation:

Je suis arrivé à faire un fichier avec un chrono qui se lance quand je remplie une cellule

Commence s'il te plait par montrer ce code. Car ce sera Ce code, qui devra être modifié (probablement très peu, d'ailleurs, si ton "chrono" a été construit avec Application.ontime)
22/03/2018, 21h51
Invité

Oui unparia a raison si c'est ce genre de chronomètre, tu dispose déjà de toutes les informations utile à ton projet.
22/03/2018, 22h17
cedric150

Ok je le met ici demain matin
Merci beaucoup à tous
23/03/2018, 07h46
cedric150

1 pièce(s) jointe(s)

Voici le fichier

Pièce jointe 363572

Dès que vous rentrez une donnée en cellule E3 , le chronometre se lance en F3 . Quand on appuie sur stop, le chrono s'arrête et récupere les données

Maintenant reste plus qu'a troiver la solution pour que le chrono commence a un temps donné (ce temps sera : Now - "heure/minute/seconde" de la cellule E3)

Merci
23/03/2018, 07h50
unparia

1)
https://www.developpez.net/forums/d8...s-discussions/
2)

Citation:

Commence s'il te plait par montrer ce code. Car ce sera Ce code, qui devra être modifié (probablement très peu, d'ailleurs, si ton "chrono" a été construit avec Application.ontime)

Il est hors de question que j'ouvre un classeur tiers.

Bonjour,

Une piste à adapter, le décompte en F3. pour le test, exécuter la sub Lancer (ici pour 10 secondes) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Sub Lancer()
    Chrono 10
End Sub
 
Sub Chrono(I As Integer)
 
    Range("F3").Value = I / 86400
 
    If I = 0 Then MsgBox "C'est fini !": Exit Sub
 
    'récursive
    Application.OnTime Now + TimeValue("00:00:01"), "'Chrono " & I - 1 & "'"
 
End Sub

26/03/2018, 15h15
cedric150

cela ne convient pas

tu as un compte à rebours de 10 secondes, je veux un chronometre qui commence à un temps T puis s'incremente chaque seconde

le code (module)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Public ProchainChrono, Départ
Sub Demarre()
 Départ = Timer()
 majChrono
End Sub
Sub majChrono()
 Sheets("Feuil1").[F3] = Format((Timer() - Départ) / 3600 / 24, "hh:mm:ss")
 ProchainChrono = Now + TimeValue("00:00:1")
 Application.OnTime ProchainChrono, "majChrono"
End Sub
Sub Arret()
 On Error Resume Next
 Application.OnTime ProchainChrono, Procedure:="majChrono", Schedule:=False
Sheets("Feuil1").Range("F3").Copy
        With Sheets("Feuil1")
            .Range("H3").PasteSpecial Paste:=xlPasteValues
        End With
    Application.CutCopyMode = False
    Range("I3") = Time
    Range("J3") = Range("I3") - Range("E3")
 
End Sub

Bonjour,

Dans un module standard :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Public FinHeure As Integer
 
Sub Chrono(I As Integer)
 
    Range("F3").Value = I / 86400
 
    If I < 0 Then MsgBox "C'est fini !": Exit Sub
 
    'récursive
    Application.OnTime Now + TimeValue("00:00:01"), "'Chrono " & I - 1 & "'"
 
End Sub

Dans le module de la feuille :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Target.Address(0, 0) <> "E3" Then Exit Sub
    If Not IsNumeric(Target.Value) Then Exit Sub
 
    If Target.Value < Time Then
 
        FinHeure = (Time - Target.Value) * 86400
        Chrono FinHeure
 
    End If
 
End Sub

Ici, il y a décrémentation mais si tu veux le contraire, change le signe dans le rappel de la fonction avec la condition de fin !

Re,

Ici, il te faut arrêter manuellement !
Dans le module de la feuille :

Code:

1
2
3
4
5
6
7
8
9
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Target.Address(0, 0) <> "E3" Then Exit Sub
    If Not IsNumeric(Target.Value) Then Exit Sub
 
    If Target.Value < Time Then Chrono (Time - Target.Value) * 86400
 
End Sub

Dans le module standard :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Dim Fin As Boolean
 
Sub Arret()
 
    Fin = True
 
End Sub
 
Sub Chrono(I As Integer)
 
    Range("F3").Value = I / 86400
 
    If Fin Then MsgBox "C'est fini !": Exit Sub
 
    'récursive
    Application.OnTime Now + TimeValue("00:00:01"), "'Chrono " & I + 1 & "'"
 
End Sub

Citation:

Envoyé par Theze

Bonjour,

Dans un module standard :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Public FinHeure As Integer
 
Sub Chrono(I As Integer)
 
    Range("F3").Value = I / 86400
 
    If I < 0 Then MsgBox "C'est fini !": Exit Sub
 
    'récursive
    Application.OnTime Now + TimeValue("00:00:01"), "'Chrono " & I - 1 & "'"
 
End Sub

Dans le module de la feuille :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Target.Address(0, 0) <> "E3" Then Exit Sub
    If Not IsNumeric(Target.Value) Then Exit Sub
 
    If Target.Value < Time Then
 
        FinHeure = (Time - Target.Value) * 86400
        Chrono FinHeure
 
    End If
 
End Sub

Ici, il y a décrémentation mais si tu veux le contraire, change le signe dans le rappel de la fonction avec la condition de fin !

Merci :)

Par contre ton code bug un peu, il affiche le temps restant et l'heure en cours en même temps :(

27/03/2018, 15h32
Theze

Bonjour,

Citation:

Par contre ton code bug un peu, il affiche le temps restant et l'heure en cours en même temps

Où ça ? Il affiche en F3 le décompte de temps (différence) qu'il y a entre l'heure à l'instant T et la valeur entrée en E3
F3 doit être formaté au format Heure
02/04/2018, 11h26
cedric150

Désolé du delai de la réponse

Il bug dans le sens ou il indique l'heure en cours et le temps qui découle en même temps en F3... Ca ne te fais pas ça ?
02/04/2018, 14h05
Theze

1 pièce(s) jointe(s)

Bonjour,

Je te poste un classeur, fait le test en entrant en E3 une heure (valide) inférieure à l'heure à l'instant T et valide en sortant de la cellule, le décompte a lieu en F3.

Pièce jointe 366565
10/04/2018, 11h09
cedric150

Merci Theze, ça fonctionne, mais si on rechange en E3 la valeur, la ça bug :(