I have adapted a regressive timer that I found here on the net and adapted to what I want. It is to be used in a cycling event and in a time trial stage where cyclists depart every 2 minutes. It works but I can not loop so that when it reaches zero (00:00:00), it throws in the sheet the start time and starts back with the time selected in combobox1
, which by your turn has several chances of choice, but once chosen is always the same.
Another thing I would like you to do was when you missed 5 seconds to end every second you sounded.
Below the code in form and module.
Noform
OptionExplicitDimTPrivateSubComboBox1_Change()TextBox1.Value=ComboBox1.ValueEndSubPrivateSubCommandButton1_Click()T=Time'DefinirqdedetempoaregredirIfRegressivoForm3.ComboBox1.Value="00:00:10" Then
Fim = Time + TimeValue("00:00:10")
End If
If RegressivoForm3.ComboBox1.Value = "00:00:15" Then
Fim = Time + TimeValue("00:00:15")
End If
Application.Run "StartTimer"
End Sub
Private Sub CommandButton2_Click()
'Para que se carregar no parar com o crono parado não dar erro
On Error Resume Next
'Para o crono
Application.OnTime Now + TimeValue("00:00:01"), "Update", , False
End Sub
Private Sub CommandButton3_Click()
TextBox1.Value = ComboBox1.Value
End Sub
Private Sub UserForm_Initialize()
With ComboBox1
.AddItem "00:00:10"
.AddItem "00:00:15"
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
StopTimer
End Sub
No modulo
Option Explicit
Dim T
Public Fim As Date, Num As Long, ComboBox1 As Long
Sub StopTimer()
'Encerra a cronometragem
On Error Resume Next
Application.OnTime T, Procedure:="Update", Schedule:=False
End Sub
Sub StartTimer()
'Verifica diferença dos segundos
If Time < Fim Then
'Atualiza a cada 1 segundo
Application.OnTime Now + TimeValue("00:00:01"), "Update"
Else
'Chama rotina para encerrar contagem
Application.Run "StopTimer"
'Quando chega aos 5 seg muda a cor para vermelho
'Verifica se o dorsal já partiu
If Range("D" & (ActiveCell.Row)).Value <> "" Then
MsgBox "Este dorsal ja iniciou a etapa!", vbCritical, "Erro"""
RegressivoForm3.TextBox2.SetFocus
End If
If Range("D" & (ActiveCell.Row)).Value = "" Then
'Seleciona a celula e poe o tempo
ActiveCell.Offset(0, 2).Select
ActiveCell.Value = Time
'Seleciona a linha e poe cor verde
Range("A" & (ActiveCell.Row), Selection.End(xlToLeft).Offset(0, 3)).Select
With Selection
.Interior.ColorIndex = 4
End With
End If
End If
End Sub
Sub Update()
RegressivoForm3.TextBox1 = Format(Fim - Time, "hh:mm:ss")
Call StartTimer
End Sub
Sub meuform()
RegressivoForm3.Show
End Sub