Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL pour MAC Chronomètre avec temps intermédiaires VBA

hypo78

XLDnaute Impliqué
Bonjour à tous,

Après une recherche sur le Forum j'ai trouvé un fichier qui fait ce dont j'ai besoin mais il fait même plus. (Chrono E.xls)
J'ai tenté d'adapter le code à mon fichier mais sans succès d'où mon appel à l'aide. Je parviens à démarrer le chrono, à l'arrêter mais pas à remplir mes cellules B4 à Q4 avec les temps intermédiaires.

Je vous joins mon fichier avec le bout de code copié qui fonctionne en partie.

Merci d'avance.
 

Pièces jointes

  • Chrono E.xls
    39.5 KB · Affichages: 42
  • Track XLD.xlsm
    22.3 KB · Affichages: 23
Dernière édition:

sousou

XLDnaute Barbatruc
Bonjour
je pense que tu n'utilises pas correctement range
essaie ceci: initialisation de colonne à 2 et remplacement des range( )par des cells()
Sub chrono()
colonne = 2 'modification
Range("S4") = ""
Range("D14") = ""
Range("D15") = ""
Range("B4:Q4").ClearContents
depart = Timer
Application.EditDirectlyInCell = False
Do
Tempsfinal = Timer - depart
TpsInter = Tempsfinal / 86400
Range("D15").Value = TpsInter
Range("S4").Value = TpsInter
If Range("D15").Value = 1 Then GoTo fin
DoEvents
Loop Until Range("D14").Value = 1
fin:
End Sub
Sub Intermediaire()
tpsarret = Range("D15").Value 'modification
'If colonne = 2 Then a = Range("l" & colonne).Value Else a = Range("l" & colonne - 1).Value
Cells(4, colonne).Value = tpsarret
colonne = colonne + 1
End Sub
 

hypo78

XLDnaute Impliqué
bonjour Sousou, bonjour le forum

ton code fonctionne à merveille mais j'aurai besoin de 2 améliorations :

  • lorsque que j'appuie sur STOP avant le 16 ème tour je souhaiterai que cette action soit combinée avec un dernier Lap autrement je n'ai pas le temps du dernier tour
  • lorsque que je fais le LAP du 16ème tour que souhaiterai que cette action soit combinée au STOP car c'est la distance maximum et il me faut le temps total à cette instant
merci d'avance pour votre contribution
 

Pièces jointes

  • Track XLD.xlsm
    22.7 KB · Affichages: 18

sousou

XLDnaute Barbatruc
bonsoir
remplace comme ceci: si stop on ajoute in intermédiare, si dernir intermédiare on arrete
Sub Intermediaire()
tpsarret = Range("D15").Value 'modification
Cells(4, colonne).Value = tpsarret
colonne = colonne + 1
If colonne = 18 Then
Range("D14").Value = 1
Application.EditDirectlyInCell = True
End If
End Sub
Sub Arret()
Intermediaire
Range("D14").Value = 1
Application.EditDirectlyInCell = True
End Sub
 

hypo78

XLDnaute Impliqué
Bonsoir Sousou,

le code est parfait mais son utilisation m'amène à une dernière demande :

j'aimerai avoir en cellule B17 le dernier lap.

Si ce n'est pas trop compliqué je suis preneur "d'une petite ligne de code".

merci d'avance
 

Pièces jointes

  • Copie de Track XLD.xlsm
    22.8 KB · Affichages: 14

hypo78

XLDnaute Impliqué
bonjour
N'est-ce pas ce que tu as?
Bonjour,

je me suis mal exprimé. Je voudrais que s'affiche le LAP du 1er tour, puis du 2ème, puis du 3ème..... le dernier Lap saisi au fur et à mesure.
En fin de compte ce qui s'affiche dans les cellules de B5 à Q5 (la dernière contenant une valeur)

En espérant avoir été plus clair

Merci
 
Dernière édition:

sousou

XLDnaute Barbatruc
Voilà.
J'ai changé en plus le bouton départ par un toogleboutton1, pour mieux gérer le bouton stop
qui présentait un défaut si plusieurs click
il n'y a pas les coins arrondis
 

Pièces jointes

  • Copie de Track XLD.xlsm
    25.2 KB · Affichages: 16

hypo78

XLDnaute Impliqué
Là je sens que je vais commencer à devenir c....
Mais dans la cellule B17, j'ai le temps cumulé alors qu'il me semblait que j'avais le dernier Lap (B5 à Q5) lors des tests ce matin...
J'ai regardé dans la version précédente mais çà me fait la même chose...

Vraiment désolé mais besoin d'un dernier petits coup de main
 

Discussions similaires

  • Question
Microsoft 365 chrono
Réponses
6
Affichages
376
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…