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.
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?
– Molx
I’m new here I can’t insert the file. How do I?
– Jonhny68
The OS is not possible, but you can put the link in some public folder of Dropbox, google drive, etc.
– Molx