Macro con reloj que hiciste

Porque gracias a un gran maestro como Dante Amor e aprendido a realizar mis primeras macros de las cuales el Reloj es uno de ellos...

El Archivo fue enviado a tu correo.

¡Gracias! ¿Qué debo modificar para que pueda hacer una cuenta regresiva en vez de hacia delante?

Hola de nuevo. Llevo varios días intentando que el reloj simplemente me muestre una cuenta atrás de 1 minuto, pero no soy capaz. No necesito más que un botón de comienzo y otro de poner a cero y si es posible que dé un mensaje cuando llegue el temporizador a cero. La fecha y el día se pueden mantener. Las 3 celdas azules que muestran a la izquierda no las necesito si ya da la hora el reloj. ¿Podrías ayudarme por favor?

Yo e modificado en la parte de la macro ActualizarHora y me resulta si te es de ayuda cambia esa parte de la macro por esta Saludos.

Sub ActualizarHora()
'Por.Dante Amor
If [D5] = "0" Then
      MsgBox "El conteo a finalizado" & vbNewLine & " Ingrese nuevo conteo "
      h1.[C3] = "Fin"
   Else
    h1.[A5] = h1.[A5] + TimeValue("00:00:01")
    h1.[D5] = h1.[D5] - TimeValue("00:00:01")
    h1.[A8] = Time
    h1.[A10] = h1.[A5] - TimeValue("00:01:00")
    Application.OnTime Now + TimeValue("00:00:01"), "ActualizarHora"
  End If
End Sub

 Me faltaba indicarte que en la celda D5 tienes que poner el tiempo que mas te convenga.

Bueno e eliminado gran parte del código y si te es de ayuda te la dejo.

Cambia todo el código por esto.

Dim l1, h1
Sub Iniciar()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")
    h1.[C3] = "Fin"
    h1.[D5] = "00:00:00"
    h1.[A5] = Time
End Sub
Sub Comenzar()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")
    If h1.[C3] = "" Then
        MsgBox "No se puede ejecutar otra vez", vbCritical, "El reloj está en ejecución"
        Exit Sub
    End If
    h1.[C3] = ""
    ActualizarHora
End Sub
Sub ActualizarHora()
'Por.Dante Amor
Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")
If [D5] = "0" Then
    MsgBox "EL CONTEO A FINALIZADO" & vbNewLine & "Ingrese nuevo tiempo"
    h1.[C3] = "Fin"
   Else
    If h1.[C3] = "Fin" Then Exit Sub
    h1.[A8] = Time
    h1.[D5] = h1.[D5] - TimeValue("00:00:01")
    Application.OnTime Now + TimeValue("00:00:01"), "ActualizarHora"
  End If
End Sub

En este caso la celda D5 tienes la opción de poner el tiempo que desees.

Muchas gracias de nuevo por la aportación. Estoy intentando pasar a mi libro el reloj y los botones, pero algo debo hacer mal porque no me funciona. Si fuera tan amable de indicarme una dirección de correo le enviaría el archivo que estoy haciendo. Es una hoja de cálculo mental para niños.

También me gustaría saber cómo copiar la cuenta atrás en otras celdas para que cuando se desplace por la hoja se pueda seguir viendo el tiempo restante.

De nuevo muchas gracias por su ayuda.

Olvidé preguntar cómo cambiar el reloj para que se vea en formato 24 horas. Gracias de nuevo

Me gustaría ayudarte mi correo es [email protected]

Te envié un correo ayer con el archivo adjunto. Muchas gracias por el ofrecimiento.

Ya te lo e enviado a tu correo espero que sea lo que buscas Saludos.

Cambia toda la macro por esto:

Dim l1, h1
Sub Iniciar()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Mental")
    h1.[Q2] = "Fin"
    h1.[F25] = h1.[F8]
    h1.[F38] = h1.[F8]
    h1.[M2] = Time
End Sub
Sub Comenzar()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Mental")
    If h1.[Q2] = "" Then
        MsgBox "No se puede ejecutar otra vez", vbCritical, "El reloj está en ejecución"
        Exit Sub
    End If
    h1.[Q2] = ""
    ActualizarHora
End Sub
Sub ActualizarHora()
'Por.Dante Amor
On Error Resume Next
Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Mental")
If [F8] = "0" Then
    MsgBox "EL CONTEO A FINALIZADO" & vbNewLine & "Ingrese nuevo tiempo"
    h1.[Q2] = "Fin"
   Else
    If h1.[Q2] = "Fin" Then Exit Sub
    h1.[M2] = Time
    h1.[F8] = h1.[F8] - TimeValue("00:00:01")
    h1.[F25] = h1.[F25] - TimeValue("00:00:01")
    h1.[F38] = h1.[F38] - TimeValue("00:00:01")
    Application.OnTime Now + TimeValue("00:00:01"), "ActualizarHora"
  End If
End Sub

Pon el tiempo en la celda F8 de ahí las demás celdas se adaptaran a ese tiempo automáticamente al presionar inicio cero.

Hola Edgar, supongo que hayas estado ocupado. Te respondí al último mail preguntando si en las celdas en las que se operan divisiones se podría hacer algo para que al generar números los resultados fuesen divisiones exactas, porque son niños pequeños los que tienen que responder y aún no saben hacerlo mentalmente. Muchas gracias.