Timer dans plusieurs cellules Excel

Résolu
raptoretienne -  
Bonjour,
j'aimerais faire une feuille excel qui me permet d'avoir plusieurs chrono dans plusieurs cellules. Je m'explique. Présentement, avec le code suivant (que j'ai trouvé dans un autre discussion) lorsque je met 1 dans B2 le chrono démarre en C2. Ce que j'aimerais c'est la même chose sauf que cela fonction aussi en B3/C3, B4/C4, etc. J'ai essayer d'insérer le code plusieurs fois à la suite en modifiant les valeurs de case sauf que cela ne fonctionne pas. Aussi, j'aimerais que le chrono démarre si j'indique 1, mais aussi 0.

Merci de votre aide. 

Option Explicit
Dim TM As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$B$2" Then
        If Target = 1 Then
            TM = True
            Timer
        Else
            TM = False
        End If
    End If
End Sub

Sub Timer()
Static S As Byte, B
    While TM
        If B <> Second(Now) Then
            Range("C2") = S
            S = S + 1
            B = Second(Now)
        End If
        DoEvents
    Wend
End Sub


17 réponses

Résumé de la discussion

Objectif : créer une feuille Excel capable de lancer simultanément plusieurs chronomètres, chacun lié à une paire de cellules (B2/C2, B3/C3, etc.), déclenché par l’entrée 1 ou 0 dans la cellule associée. Des tentatives ont consisté à copier le code VBA initial dans plusieurs blocs pour étendre la logique, mais la synchronisation et l’activation par ligne n’étaient pas fiables, surtout sous Mac OS. Plusieurs informations complémentaires évoquent des approches alternatives, notamment l’utilisation du clic droit, l’idée de gérer jusqu’à 40 compteurs pour tester les performances CPU, et des scénarios où 0 ou 1 déclenchent des chronomètres propres.

Bobot (l’IA à votre service)
  1. f894009
    Bonjour,

    Moins gourmand en CPU:

    dans un module: 

    Option Explicit
Public TM(3) As Boolean     'Flag L/S timer
  
Sub Timer_C2()
    With Worksheets("feuil1")
        .Range("C2") = .Range("C2") + 1     'incremente cellule
    End With
    If Not TM(0) Then       'si pas stop
        Application.OnTime Now + TimeValue("00:00:01"), "Timer_C2"      'boucle sur procedure au bout de 1 seconde
    End If
End Sub

Sub Timer_C3()
    With Worksheets("feuil1")
        .Range("C3") = .Range("C3") + 1
    End With
    If Not TM(1) Then
        Application.OnTime Now + TimeValue("00:00:01"), "Timer_C3"
    End If
End Sub

Sub Timer_C4()
    With Worksheets("feuil1")
        .Range("C4") = .Range("C4") + 1
    End With
    If Not TM(2) Then
        Application.OnTime Now + TimeValue("00:00:01"), "Timer_C4"
    End If
End Sub


    Dans VBA de la feuille: 
    Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("B2:B4")) Is Nothing Then
        If Target = 1 Then
            TM(Target.Row - 2) = False          'flag lance timer
            Range("C" & Target.Row) = -1        'init timer
            Application.Run "Timer_C" & Target.Row  'lance le timer
        Else
            TM(R) = True    'stop timer
        End If
    End If
End Sub


    Y a encore moins gourmand avec des timers system(non gerer par excel) mais faut voir si vous avez bien plus de 4 timers
    0
    1. raptoretienne Auteur
      Merci, je vais essayer cela lors de mon retour a la maison, je te tiens au courant!

      Et en fait je pensais avoir besoin de 40 timers, est ce que ça bouffe trop de cpu?
      0
      1. f894009
        Re,

        y a une erreur suite oubli apres des modifs 

        TM(R) = True    'stop timer


        devient apres des modifs 

        TM(Target.Row - 2) = True    'stop timer


        besoin de 40 timers Faut que je teste. Avec 3 timers de "mon" code, excel prend mois de 1% CPU sur mon PC, apres ca depend du PC. Par contre avec votre code de depart, 1 timer 30% CPU
        0
    2. raptoretienne Auteur
      J'ai essayé avec les modifications et j'obtiens cette erreur:
      Erreur de compilation:

      Sub ou Function non définie
      (Feuille1 5:12)

      :(
      0
      1. eriiic Contributeur
        Bonjour à tous,

        f894009, il ne faudrait pas mémoriser les heures de lancement et désactiver les timers dans workbook.close ?
        Pour éviter que le fichier se rouvre s'il y en a un en cours.
        eric
        0
        2. raptoretienne Auteur
          Pour mon erreur, je met le premier code dans thisworksheet et le deuxième code dans Feuille1 comme suit: je ne sais pas si ça peut aider.
          0
          1. pijaku Modérateur
            Bonjour,

            Ben oui.
            Ce code, comme l'a dit f894009 doit être dans un module standard (Insertion/Module sous VBA).
            En faisant cela, vous rendrez "visible" les fonctions qu'il contient dans tout votre classeur.
            Et donc vous n'aurez plus l'erreur Sub ou Function non définie ...
            CQFD

            EDIT : une petite erreur toutefois dans le code WorkSheet_Change().
            Remplacer : 
            TM(R) = True

            par : 
            TM(Target.Row - 2) = True
            0
        3. f894009
          Bonjour a tous
          eriic:
          il ne faudrait pas mémoriser les heures sais pas ce qu'il veut en faire donc pour le moment code pour compter, apres nous aviserons

          pijaku:
          Merci du rappel, c'etait pourtant ecrit !!!!!

          raptoretienne
          Je vais tester 40 compteurs actifs pour le CPU et voir comment coder au plus juste
          0
          1. f894009
            Re,

            raptoretienne:

            J'ai teste avec 24 et ca roule. Mais que voulez vous faire, car si vous avez l'idee de saisir dans d'autres cellules pendant le comptage,ca le bloque et c'est normale
            0
            1. raptoretienne Auteur
              En fait je voulais une colonne avec les chiffres 1 et 40 qui représente 40 tests, selon le résultats (+/-) j'insère 0 ou 1 dans la colonne adjacente et le chrono démarre, à 40 secondes, je peux faire le test numéro 2, etc.
              0
              1. f894009
                Re,

                Est-ce que vous aurez jusqu'a 40 chronos actifs en meme temps, expliquez un peu plus svp ??

                j'insère 0 ou 1 Quelle difference entre les deux puisque le chronos demarre ??
                0
            2. raptoretienne Auteur
              C'est pour un projet de recherche, le patient passe un test d'odorat, s'il identifie la bonne odeur, il se mérite un 1, sinon un 0. Entre chaque odeur, il doit y avoir un délai de 40 secondes. À la fin, avec je pourrai faire une sommation de la colonne faire les analyses au besoin. Le timer ici n'est pas essentiel, il me permettrait seulement de tout avoir mes outils sur une même feuille excel.

              PS: merci beaucoup, j'ai réussi à faire marcher ton code sans erreur, toutefois, seulement la valeur 1 semble déclencher le code et non pas la valeur 0 aussi?
              0
              1. f894009
                Bonjour,

                Oui, seul 1 declanche pour l'instant.
                Entre chaque odeur, il doit y avoir un délai de 40 secondes
                Si j'ai bien compris, un seul chronos suffirait ou j'ai loupe un bout du film ??

                code modifie pour 0 et 1
                VBA Feuille: 

                Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Range("B2:B25")) Is Nothing Then
        If Target <> "" And (Target.Value = 1 Or Target.Value = 0) Then
            TM(Target.Row - 2) = False          'flag lance timer
            Range("C" & Target.Row) = -1        'init timer
            Application.Run "Timer_C" & Target.Row  'lance le timer
        Else
            TM(Target.Row - 2) = True    'stop timer
        End If
    End If
End Sub
                0
            3. raptoretienne Auteur
              En fait, comme c'est la, il me resterais qu'à mettre les cases jusqu'à B41/C41 et ça fonctionnerais. Mais oui un seul chrono pourrait fonctionner, ex: je rentre 0/1 dans B2 le chrono démarre en C2, ensuite attente de 40 secondes, je rentre de nouveau 0/1 en B3, le chrono de C2 pourrait reprendre de 0, attente de 40 secondes, etc.

              Je ne sais pas si c'est assez clair haha.
              Merci beaucoup pour votre aide, je n'y comprend pas grand chose à cette bouillie pour les chats :)
              0
              1. f894009
                Re,
                Petit détail, le chrono c'est pour les 40s d'attente et le 0 ou 1 c'est pour le chrono de la cellule suivante ????
                0
            4. raptoretienne Auteur
              Oui exactement: j'insère 0/1 --> 40 secondes --> j'insère 0/1 --> 40 secondes --> j'insère 0/1 (répéter 40 fois).
              0
              1. f894009
                Bonjour,
                Je regarde la chose
                À+
                0
            6. raptoretienne Auteur
              J'ai excel sur mac, je crois que c'est moyen compatible, rien ne se passe lorsque je clique sur start ou stop.
              0
            7. raptoretienne Auteur
              fonctionne pas non plus :(
              0
              1. f894009
                Re,
                Et oui, il y a aussi les boutons qui ne vont pas. Demain, je remplace ces boutons contrôle activex. Je prendrai un Mac pour faire les modifs
                À+
                0
            9. raptoretienne Auteur
              Comment je fais pour que cela fonctionne? je clique sur start ça ne fais rien, dès que je clique sur une case je suis redirigé faire A1, pas moyen d'insérer 0 ou 1.

              Merci
              0
              1. f894009
                Re,

                J'ai ecrit qu'il fallait utiliser le CLIC DROIT SOURIS
                0
            10. raptoretienne Auteur
              Super merci beaucoup :)
              0