Discussion :

[cedric150]

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

[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/

[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

[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.

[kiki29]

Salut, à tout hasard : Chronomètres

[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é

[unparia]

Bonjour

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)

[Invité]

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

[cedric150]

Ok je le met ici demain matin
Merci beaucoup à tous

[cedric150]

Voici le fichier


test minuteur - Copie.xlsm

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

[unparia]

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

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.

[Theze]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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

[cedric150]

le code (module)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Theze]

Bonjour,

Dans un module standard :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !

[Theze]

Re,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[cedric150]

Bonjour,

Dans un module standard :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Theze]

Bonjour,

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

[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 ?

[Theze]

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.

Test décompte.xlsm