Countdown timer but when it reaches zero it resumes?

3

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 
    
asked by anonymous 22.05.2015 / 20:57

0 answers