Autres Multichrono à problèmes

a26

XLDnaute Occasionnel
Bonjour à tous,
Quelqu'un peut-il m'aider à résoudre le problème suivant. Un fichier multichrono parfait sauf que les chronos s'arrêtent dès qu'il y a une saisie dans une cellule de la page. Ayant besoin de faire des saisies sur cette même feuille je ne vois pas comment modifier la macro.
Merci pour votre aide.
Cordialement,
a26
 

Fichiers joints

a26

XLDnaute Occasionnel
Bonjour,
Je reviens vers vous. Quelqu'un aurait-il une solution à ce problème.
Merci.
a26
 

Dranreb

XLDnaute Barbatruc
Bonjour.
On ne peut pas éviter qu'Excel s'accapare la main pendant l'édition d'une cellule, empêchant la mise à jour de l'affichage d'un chronomètre.
Mais ça n'arrête pas le temps quand même ! Alors je ne vois pas bien où est le problème.
Il n'y en a pas dans le classeur joint en tout cas.
 

Fichiers joints

Dernière édition:

a26

XLDnaute Occasionnel
Bonjour Dranreb,
Merci pour ta réponse mais cela ne me résous pas le problème. Le temps écoulé en colonne D se fige dès qu'il y a une saisie sur cette feuille ou une autre.
 

Dranreb

XLDnaute Barbatruc
Il faut procéder autrement je pense.
Ce n'est pas normal d'empêcher la Sub Worksheet_BeforeDoubleClick de se terminer en lui imposant l'appel d'une procédure qui ne se termine pas. Essayez une procédure qui se rappelle elle meme toutes les secondes par un Appilcation.OnTime, ou utilisez un dispositif de mon classeur qui fonctionne.
 

Dranreb

XLDnaute Barbatruc
Faire quoi ?
Pour l'utilisation d'un UFmChrono il y a des commentaires explicatifs de ses propriétés et méthodes dedans, et des exemples de lancements dans le module ADémo.
 

a26

XLDnaute Occasionnel
Voilà ce que j'ai quand j'ouvre ton fichier en PJ.
Je ne suis pas assez calé en VBA pour m'en sortir.
Cordialement,
a26
1032020
 

Dranreb

XLDnaute Barbatruc
Remplacez dans tout le projet tous les PtrSafe par rien.
Dans la mesure où le défilement du temps, qui ne sert à rien de toute façon, peut être interrompu par des manœuvre dans Excel, à votre place je noterais plutôt dans la colonne D l'heure d'arrivée, et dans le module de la feuille:
VB:
Option Explicit
            #If VBA7 Then
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
            #Else
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
               #End If
Private CycMinuit As Currency, Fréq As Currency
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Heure As Double
   Heure = HeurePrécise
   If Target.Column <> 2 Or Target.CountLarge <> 1 Then Exit Sub
   Select Case Target.Value
      Case "Go":   Target.Offset(, 1).Value = Heure
         Target.Offset(, 2).Value = Empty: Target.Offset(, 3).Value = Empty: Target.Value = "Stop"
      Case "Stop": Target.Offset(, 2).Value = Heure
         Target.Offset(, 3).FormulaR1C1 = "=RC4-RC3": Target.Value = "Go"
      End Select
   Target.Offset(, 1).Resize(, 3).NumberFormat = "hh:mm:ss.000"
   End Sub
Function HeurePrécise() As Double
   Dim Cyc As Currency, CycTrv As Currency
   QueryPerformanceCounter Cyc
   If CycMinuit = 0 Or Fréq = 0 Then
      Dim Ti As Single, Ts As Single
      QueryPerformanceFrequency Fréq
      Ti = Timer: Do: Ts = Timer: Loop Until Ts <> Ti
      QueryPerformanceCounter CycTrv
      CycMinuit = CycTrv - Ts * Fréq
      End If
   HeurePrécise = (Cyc - CycMinuit) / (Fréq * 86400)
   End Function
 

a26

XLDnaute Occasionnel
Merci Dranreb, je teste cet après-midi et je te donne une réponse sur le résultat. Excuse moi de ne pouvoir le faire dans la continuité mais je dois m'absenter.
Cordialement,
a26
 

Dranreb

XLDnaute Barbatruc
Au cas où ça devait pouvoir fonctionner durant le passage à l'heure de minuit, j'insèrerais la date en colonne C.
Il ne faut pas l'intégrer, même non affichée par le format de cellule, à l'heure: celle ci perdrait en précision.
La programmation devient alors celle ci :
VB:
Option Explicit
            #If VBA7 Then
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
            #Else
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
               #End If
Private CycMinuit As Currency, Fréq As Currency
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Heure As Double
   Heure = HeurePrécise
   If Target.Column <> 2 Or Target.CountLarge <> 1 Then Exit Sub
   Select Case Target.Value
      Case "Go":   Target.Offset(, 1) = Date: Target.Offset(, 2).Value = Heure
         Target.Offset(, 3).Value = Empty: Target.Offset(, 4).Value = Empty
         Target.Value = "Stop": Target.Offset(, 1).Resize(, 2).Select
      Case "Stop": Target.Offset(, 3).Value = Heure + (Date - Target.Offset(, 1))
         Target.Offset(, 4).FormulaR1C1 = "=RC[-1]-RC[-2]"
         Target.Value = "Go": Target.Offset(, 3).Resize(, 2).Select
      End Select
   Target.Offset(, 1).NumberFormat = "ddd dd mmm"
   Target.Offset(, 2).Resize(, 3).NumberFormat = "[h]:mm:ss.000"
   End Sub
Function HeurePrécise() As Double
   Dim Cyc As Currency, Ti As Single, Ts As Single, CycTrv As Currency
   QueryPerformanceCounter Cyc
   If CycMinuit = 0 Or Fréq = 0 Then
      QueryPerformanceFrequency Fréq
      Ti = Timer: Do: Ts = Timer: Loop Until Ts <> Ti
      QueryPerformanceCounter CycTrv
      CycMinuit = CycTrv - Ts * Fréq
      End If
   HeurePrécise = (Cyc - CycMinuit) / (Fréq * 86400)
   End Function
 

a26

XLDnaute Occasionnel
J'ai essayé toutes sortes de manip mais certainement mauvaises car je n'obtiens rien de satisfaisant.
 

Dranreb

XLDnaute Barbatruc
Ben joignez ce que vous avez essayé, que je vois pourquoi ça ne marche pas. Vous n'êtes pas sur MAC au moins, j'espère :eek: ?
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
D'ailleurs je ne sais mème pas ce que vous voulez essayer: Est-ce d'implanter un UFmChrono dans votre classeur ou d'essayer la procédure proposée au poste #11 ?
Attention: l'UFmChrono a besoin du module de classe Rythmeur, qui lui même utilise le module de service MRythmeur. Il faut donc glisser/déplacer non seulemnt l'UFmChrono vers votre projet, mais aussi ces deux choses.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Il ne fallait rien toucher au Progression.xlsm à part pour supprimer les PtrSafe (obligatoires sur systèmes 64 bits) non supportés chez vous.
Vous avez complètement fusillé les démo associées aux évènements de la feuille en remplaçant tout le code par celui qui était destiné à votre classeur.
Le multichrono1 me semble bon. Vous pouvez diminuer le nombre de chiffres après la virgule des secondes dans les NumberFormat si vous voulez. Rappel: la colonne E est maintenant l'heure d'arrivée. C'est plus sûr.
 

a26

XLDnaute Occasionnel
Un grand merci Dranreb pour ton aide, si je n'ai pas réussi dans progression à mettre en colonne A la liste avec déclenchement de chrono pour l'autre fichier tout est parfait.
Bonne fin d'après midi.
Cordialement,
a26
 

Dranreb

XLDnaute Barbatruc
Il ne fallait pas essayer de le faire dans progression. Dans l'explorateur de projet, il fallait glisser/déplacer de son projet vers celui de votre classeur les noms UFmChrono, MRythmeur et RYthmeur (le dernier est dans la rubrique modules de classe) et travailer avec les éléments ainsi installés.
 

a26

XLDnaute Occasionnel
Encore une question car je n'avais pas vu votre réponse qu'ai-je fait pour avoir " complètement fusillé les démo associées aux évènements de la feuille " ???
 

Dranreb

XLDnaute Barbatruc
Vous aviez remplacé la programmation du WshDémo par celle destinée à l'objet worksheet représentant votre feuille "chronos"
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas