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