Discussion :

[Mathsdeb]

Bonjour,

D'abord merci pour la création de ce forum .

Je cherchais comment installer un chronomêtre sur Excel et grace à ce forum j'ai trouvé ma réponse mais j'ai un petit souci parce que le chronometre ne prend pas en compte les doublons (ci-joint le fichier). Exemple si je veux que le chrono prend en compte l'activité "01" 2 fois dans la même journée, il me dit que le "01" existe déjà. En fait je dois chronométrer des activites dans la journéee sauf que des fois dans la même journée je peux être amener à traiter plusieurs fois la même activité. Pouvez vous m'aider SVP à trouver une solution?

Merci par avance

[Mathsdeb]

Bonsoir gfz82,

En fait je ne veux pas justement que l élément soit supprimé, je veux Qu il passe a l autre cellule automatiquement et que même si la même activité est répétée plusieurs fois qu il ne soit pas supprimé. Je ne sais pas si je me suis bien fait comprendre.

Merci pour ton aide

[gFZT82]

Bonjour,

Si je comprends bien :
1) Tu entres un numéro d’activité en D2 : le numéro d’activité s’inscrit dans la première cellule vide de la colonne A. Le Top départ s’inscrit dans la cellule adjacente (colonne B).
2) Tu arrêtes le chrono. Le Top fin s’inscrit dans la cellule adjacente (colonne C). La durée du chronométrage est indiquée en colonne D.
3) Tu entres un autre numéro d’activité en D2 (ou éventuellement le même) : le numéro d’activité s’inscrit dans la première cellule vide de la colonne A, c'est-à-dire sous la ligne précédente.
Etc.
Tu obtiens ainsi une série d’activités chronométrées.
Voir exemple joint.

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub Depart()
Dim LigneAjout As Long
    With Worksheets("Feuil1")
        'On recherche la première cellule vide en colonne A
        LigneAjout = .Range("A" & Rows.Count).End(xlUp).Row + 1
        'On contrôle que le comptage précédent est achevé,
        'sinon, on efface la saisie et on sort de la procédure
        If Application.CountA(.Range("A" & LigneAjout - 1).Resize(, 4)) <> 4 Then
            .Range("D2") = ""
            .Range("D2").Select
            Exit Sub
        End If
        'On note le numéro d'activité
        .Range("A" & LigneAjout) = .Range("D2")
        'On note l'heure du démarrage chrono
        .Range("B" & LigneAjout) = Format(Time, "hh:mm:ss")
        'On colorie le fond en jaune
        .Range("A" & LigneAjout).Resize(, 2).Interior.ColorIndex = 36
        'On efface le numéro d'activité
        .Range("D2") = ""
        'On se repositionne sur le numéro d'activité
        .Range("D2").Select
    End With
End Sub
Sub Arret()
Dim DerLig As Long
    With Worksheets("Feuil1")
        'On recherche la dernière cellule renseignée en colonne A
        DerLig = .Range("A" & Rows.Count).End(xlUp).Row
        'On contrôle que le comptage a bien démarré, sinon on sort de la procédure
        If Application.CountA(.Range("A" & DerLig).Resize(, 3)) <> 2 Then Exit Sub
        'On note l'heure du top fin chrono
        .Range("C" & DerLig) = Format(Time, "hh:mm:ss")
        'On calcule la durée du chronométrage
        .Range("D" & DerLig) = Format(.Range("C" & DerLig) - .Range("B" & DerLig), "hh:mm:ss")
        'On colorie le fond en jaune
        .Range("A" & DerLig).Resize(, 4).Interior.ColorIndex = 38
    End With
End Sub
Sub Zero()
Dim DerLig As Long
    With Worksheets("Feuil1")
        'On recherche la dernière cellule renseignée en colonne A
        DerLig = .Range("A" & Rows.Count).End(xlUp).Row
        'On efface le numéro d'activité
        [D2] = ""
        'On efface les comptages
        With .Range("A4:D" & DerLig)
            .ClearContents
            .Interior.ColorIndex = xlNone
        End With
    End With
End Sub

Cordialement.

[Mathsdeb]

Bonjour Gfzt82,

Merci beaucoup pour ta réponse c est exactement ce que je voulais

Très bonne journée et 1000 merci encore!!!

Cordialement

[Mathsdeb]

Bonsoir,

Sur le fichier excel que m'a envoyé gFZT82, je voudrais rajouter dupliquer la feuil1 pour avoir exactement la même chose dans les onglets que je nommerai par exemple Lundi = onglet 1; Mardi = onglet 2 ... jusqu'à Samedi

Or lorsque je veux dupliquer l'onglet "Feuil1" des erreurs apparaissent et la macro ne fonctionnent plus.

Merci beaucoup pour votre aide

Cordialement

[gFZT82]

Bonsoir,

Pour permettre l’utilisation du programme dans plusieurs feuilles, on utilise l’évènement SheetChange du classeur. Le code se trouve dans le module ThisWorkbook.
Les procédures de lancement chrono, arrêt et RAZ s’appliquent à la feuille active.
Pour ajouter une feuille, il te suffit de faire un copier d’une feuille renseignée.

Cordialement.