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

1 Respuesta

4.583.925 pts. Sancho, si los perros ladran ...

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 Sub

El 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:

https://youtu.be/m7Uob2BxhJU 


':)
':)

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas