Regressive chronometer but when it reaches zero starts again?

Asked

Viewed 2,256 times

3

I 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 race and in a time trial stage where cyclists depart every 2 minutes. It works but I can’t do the loop so that when it reaches zero (00:00:00), launches on the sheet the time of departure and back start with the time selected in the combobox1, who in turn has several choices, but once chosen is always the same.

Another thing I’d like you to do is when it’s five seconds to go and every second makes a sound.

Below the code in the form and module.

inserir a descrição da imagem aqui

In the form

 Option Explicit
 Dim T
 Private Sub ComboBox1_Change()
 TextBox1.Value = ComboBox1.Value
 End Sub
 Private Sub CommandButton1_Click()
 T = Time
 'Definir qde de tempo a regredir
 If RegressivoForm3.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 
  • You can provide example file?

  • I’m new here I can’t insert the file. How do I?

  • The OS is not possible, but you can put the link in some public folder of Dropbox, google drive, etc.

No answers

Browser other questions tagged

You are not signed in. Login or sign up in order to post.