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

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:rolleyes:
 

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
332

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof