Cómo crear cronometro con centésimas de segundo ?
"para Dante Amor"
Buenas tardes
En mi pregunta anterior me ayudaron con el botón para detener el cronometro, Ahora viendo el cronometro este inicia con los segundos y me gustaría que también se muestren las centésimas de segundo para que queden registradas al momento de detener el cronometro, he tratado de cambiarle el formato en el código pero no he logrado lo deseado.
El código que actualmente tengo es el siguiente :
Sub ProgramaCuentaRegresiva()
Dim CuentaRegresiva As Date
CuentaRegresiva = Now + TimeValue("00:00:01")
Application.OnTime CuentaRegresiva, "ProgramaCuenta"
End Sub
Sub ProgramaCuenta()
On Error Resume Next ' omite mensajes de error de access
Dim Cuenta As Range
'Set Cuenta = [A2]
Set Cuenta = ActiveCell
Cuenta.Value = Cuenta.Value + TimeSerial(0, 0, 1)
If Cuenta <= 0 Then
MsgBox "Terminó el Conteo", vbExclamation, "Cuenta Regresiva"
Exit Sub
End If
Call ProgramaCuentaRegresiva
End Sub
Sub DetenerCuentaRegresiva()
On Error Resume Next ' omite mensajes de error de access
Dim CuentaRegresiva As Date
CuentaRegresiva = Now + TimeValue("00:00:01")
Application.OnTime CuentaRegresiva, "ProgramaCuenta", , False
End Sub
1 Respuesta
H o l a:
Cambia tus macros y utiliza solamente estas 2 macros:
Sub ProgramaCuenta()
'Act.Por.Dante Amor
Dim Cuenta As Range
Set Cuenta = ActiveCell
Do While True
Cuenta = Format(Hour(Now), "00") & ":" & _
Format(Minute(Now), "00") & ":" & _
Format(Second(Now), "00") & "." & _
Format((Timer - Int(Timer)) * 100, "00")
DoEvents
Loop
Cuenta = TimeSerial(Hour(Now), Minute(Now), Second(Now)) + TimeSerial(0, 0, 1)
CuentaRegresiva = Now + TimeValue("00:00:01")
Application.OnTime CuentaRegresiva, "ProgramaCuenta"
End Sub
'
Sub DetenerCuentaRegresiva()
'Por.Dante Amor
On Error Resume Next
Dim CuentaRegresiva As Date
CuentaRegresiva = Now + TimeValue("00:00:01")
Application.OnTime CuentaRegresiva, "ProgramaCuenta", schedule:=False
End
End SubEl formato de la columna donde vas a poner el cronometro tiene que tener el siguiente formato:
hh:mm:ss.00
Como se muestra en la siguiente imagen:
ejemplo:
':) ':)
Hola
La parte de centésimas de segundo esta muy bien con ese formato, lo único es que tu macro cuando selecciono la celda activa continua el cronometrenado segun el tiempo anterior,
la macro que encontré y adapte a mis necesidades, en cada celda inicia con un tiempo nuevo. estoy tratando de modificar tu macro. pero si me puedes ayudar bienvenida tu ayuda!!
H o l a:
Ya lo resolví.
Cambia las macros por las nuevas macros:
Sub Iniciar() 'Por.Dante Amor [A2] = Time [A3] = (Timer - Int(Timer)) * 100 If ActiveCell.Column > 3 Then ActualizarHora Else MsgBox "Selecciona una celda de la columna D" End If End Sub ' Sub ActualizarHora() 'Por.Dante Amor Do While [A2] <> "" [B2] = Time [C2] = "=B2-A2" [B3] = (Timer - Int(Timer)) * 100 [C3] = "=if(B3<A3,B3+100-A3,B3-A3)" ActiveCell = Format(Hour([C2]), "00") & ":" & _ Format(Minute([C2]), "00") & ":" & _ Format(Second([C2]), "00") & "." & _ Format([C3], "00") DoEvents Loop End Sub ' Sub Detener() 'Por.Dante Amor [A2] = "" End Sub
Indicaciones:
- Necesitamos reservar las celdas A2, B2, C2 y A3, B3 y C3, para realizar los cálculos.
- Pon la macro Iniciar en un botón y en otro botón pon la macro Detener.
- Entonces, si no tienes problema, utiliza las celdas de la columna D en adelante, recuerda poner en las columnas el formato hh:mm:ss. 00 para que se vean las centésimas.
Recuerda cambiar la valoración a la respuesta.
Sal u dos
