Créer un laptimer dans une macro Excel

Bonjour à tous,

Je suis nouveau sur ce forum. Je cherche de l'aide à propos de la création d'un laptimer (afficher un chronomètre tour par tour) pour plusieurs autos.

La finalité de ce projet est une d'aider la personne chargée des stratégies de course dans un championnat automobile.

Mon problème actuel est que dans ma formule qui gère cela affiche la différence de temps entre l'heure de départ et l'heure actuelle. Or je souhaiterai obtenir un chrono tour par tour.

Voici ce que j'ai pour le moment :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Application.Intersect(Target, Range("C3:C20")) Is Nothing Then

If Target.Count > 1 _

Or ActiveSheet.CommandButton1.Visible = True _

Or IsEmpty(Target.Value) _

Or Target.Interior.ColorIndex = 15 Then Exit Sub

Cells(Target.Row, 255).End(xlToLeft).Offset(0, 1) = Time - [B3]

If Cells(Target.Row, 255).End(xlToLeft).Column = 20 Then Target.Interior.ColorIndex = 15

[A1].Select

End If

End Sub

Merci pour votre aide.

Bonjour

Un fichier et un Code de Myta qui devrait répondre à ta question

Cordialement

380coursechrono.zip (14.71 Ko)

Bonjour amadeus,

Merci pour ta réponse. J'ai essayé le fichier que tu m'as envoyé, lorsque je clique sur la dossard 1 il m'indique effectivement le temps qu'il a fallu pour parcourir un tour, mais lorsque je clique une seconde fois (pour la fin du second tour donc) il ne m'indique pas le temps qu'il a fallu pour parcourir le second tour mais le temps total, or c'est p

précisément mon problème:

L'idéal serait de faire une incrémentation, c'est à dire à partir du second tour la formule n'est plus :

Time - [B3]

mais : Time - la somme des temps depuis le début de la course.

Le hic c'est que mes connaissances sont assez limitées ! Help !

Bonjour

Juste une adaptation du code

Il doit y avoir plus simple

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("C3:C20")) Is Nothing Then
If Target.Count > 1 _
    Or ActiveSheet.CommandButton1.Visible = True _
        Or IsEmpty(Target.Value) _
            Or Target.Interior.ColorIndex = 15 Then Exit Sub
  cl = Cells(Target.Row, 255).End(xlToLeft).Offset(0, 1).Column
  If cl = 4 Then
    Cells(Target.Row, cl) = Time - [b3]
  Else
    Cells(Target.Row, cl) = (Time - [b3]) - Application.Sum(Range(Cells(Target.Row, 4), Cells(Target.Row, cl - 1)))   '[B3]
  End If
  If cl = 13 Then Target.Interior.ColorIndex = 15
[A1].Select
End If
End Sub

Bonjour

ou comme cela avec en B6 la somme des temps déjà comptabilisés.

Cordialement

215coursechrono.zip (14.89 Ko)

Merci beaucoup ca fonctionne comme je le souhaitais !

Maintenant autre chose me chagrine, j'ai inséré une MsgBox qui apparait à un moment t. Lorsque celle ci apparait mon chrono ne fonctionne plus (forcément) puisque la macro attends que je clique sur "OK" avant de continuer.

Comment faire pour que mon chrono tourne même lorsque la MsgBox est affichée ?

J'ai tenté de faire un Do While mais j'ai juste réussi à planter Excel

Voici ce que j'ai (sans la boucle while)

Public Sub Chrono()
    Dim Reponse As VbMsgBoxResult

    Temps = Now + TimeValue("00:00:01")
    Application.OnTime Temps, "Chrono"
    Sheets("Feuil1").Range("B9").Value = Time
    Sheets("Feuil1").Range("B7").Value = Durée
    Durée = Durée + TimeValue("00:00:01")

    If Sheets("Feuil2").Range("B3").Value = Sheets("Feuil1").Range("B7").Value Then       'affichage fenetre d'information : ici PIT LANE OPEN
    MsgBox "Ouverture Pit Lane", vbInformation + vbOKOnly, "Boite "

    End If

   If Sheets("Feuil2").Range("B4").Value = Sheets("Feuil1").Range("B7").Value Then       'affichage fenetre d'information : ici PIT LANE CLOSED
   MsgBox "Fermeture Pit Lane", vbInformation + vbOKOnly, "Boite "
   End If

    End Sub
Rechercher des sujets similaires à "creer laptimer macro"