Bonjours Est t'il possible de pouvoir faire en sorte que je puisse avoir 2 compteur en même temps dans ma feuille .
Le compteur (comte a Rebours) Démarre lorsque une cellule de la colonne E est modifier.
Merci de votre aide.
Merci infiniment.
La feuille est joint en téléchargement au besoin.
Les code
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Tablo(0 To 1) As String
If Target.Column = 3 Then
Cancel = True
Tablo(0) = "Au dessu": Tablo(1) = "En dessou"
Randomize
Target = Tablo(Int(2 * Rnd))
End If
End Sub
Public Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
Temp# = Target.Row
Cells(Temp#, 6) = 60
Call RunOnTime
ElseIf Target.Row = Temp# And Target.Column = 7 Then
'ElseIf Not Application.Intersect(Target, Range("G:G")) Is Nothing Then
Target.Offset(0, 2) = Now 'Date
End If
End Sub
MODULE1
Option Explicit
Public Temp#
Public dTime As Date
Sub RunOnTime()
dTime = Now + TimeSerial(0, 0, 1)
Application.OnTime dTime, "RunOnTime"
Cells(Temp#, 6).Value = Cells(Temp#, 6).Value - 1
If Cells(Temp#, 6).Value = 0 Then Call CancelOnTime
End Sub
Sub CancelOnTime()
Application.OnTime dTime, "RunOnTime", , False
Cells(Temp#, 6).Value = "Terminer"
End Sub
Sub Inversion()
Dim Tablo
Dim J As Long, NbLg As Long
Application.ScreenUpdating = False
NbLg = Range("C" & Rows.Count).End(xlUp).Row
Tablo = Range("C2:C" & NbLg)
For J = 1 To UBound(Tablo)
If Tablo(J, 1) <> "" Then
Tablo(J, 1) = IIf(UCase(Tablo(J, 1)) = UCase("AU DESSU"), "EN DESSOU", "AU DESSU")
End If
Next J
Range("C2").Resize(UBound(Tablo)) = Tablo
End Sub
'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' If Target.Column = 3 And Target.Row > 1 Then
' Cancel = True
' If UCase(Target) = UCase("Au dessu") Then
' Target = "En dessou"
' ElseIf UCase(Target) = UCase("En dessou") Then
' Target = "Au dessu"
' End If
' End If
'End Sub