Macro para crear reloj en cuenta regresiva

Dam, en esta oportunidad necesito crear un reloj digital que realice el conteo en cuenta regresiva, el mismo se debe ejecutar en un Label de un formulario con la propiedad caption.

Al respecto tengo las siguientes necesidades:

  1. Que el tiempo lo pueda definir y modificar para cada ejecución si lo deseo.
  2. Que adicional el tiempo si no lo defino desde el inicio, se determine en una constante de 45 minutos, "00:45:00".
  3. Que al llegar a valor de Cero "00:00:00", se me dispare un msgbox avisando que el tiempo concluyó y se me cierre el formulario con Unload Me.
  4. Debe tener el botón de "Iniciar conteo", "Detener conteo", "Reiniciar conteo" y "Finalizar conteo"
Option Explicit
Dim StopTimer As Boolean
Private Sub btn_play_Click()
  'Start the timer
  Const Minutes = 1   ' fija un valor constante de 1 minuto
                      ' Quisiera poder variar este valor, puede ser desde 
                      ' valor ingresado a una celda
  Dim EndTime As Double
  StopTimer = False
  Do
    If EndTime - Now < 0 Then
      EndTime = Now + TimeSerial(0, Minutes, 0)
    End If
'    Range("A1") = EndTime - Now
        Me.lbl_reloj.Caption = EndTime - Now
        Range("A1") = EndTime - Now
        Me.lbl_reloj.Caption = Range("A1")
        Me.lbl_reloj.Caption = Format(Range("A1"), "hh:mm:ss")
        Me.lbl_reloj.Font.Name = "Arial"
        Me.lbl_reloj.Font.Size = 13
    DoEvents
  Loop Until StopTimer
End Sub
Private Sub CommandButton2_Click()
  'Stops the timer
  StopTimer = True
End Sub

Este código, lo obtuve investigando por la red y le hice unas modificaciones, pues originalmente el conteo lo ejecuta en una celda pero no en formulario, Ahora al llegar a cero se me reinicia el conteo, sea en la celda o en el formulario.

1 Respuesta

Respuesta
2

H o l a :

Te anexo el código que tienes que poner en el formulario.

Primero pon la información de hora, minuto y segundo en las celdas B2, C2 y D2.

En el formulario tienes que tener 4 botones, CommandButton1, 2, 3 y 4, para Iniciar, Detener, Reiniciar y Finalizar.

Y un label con el nombre de lbl_reloj:



Dim StopTimer As Boolean
Dim reiniciar As Boolean
'
Private Sub CommandButton1_Click()
'Act.Por.Dante Amor
    'Start the timer
    Dim EndTime As Double
    StopTimer = False
    tiempo = Split(lbl_reloj, ":")
    If UBound(tiempo) < 2 Then
        reiniciar = False
    End If
    If reiniciar Then
        hora = tiempo(0)
        minu = tiempo(1)
        segu = tiempo(2)
        reiniciar = False
    Else
        hora = [B2]
        minu = [C2]
        segu = [D2]
    End If
    Me.lbl_reloj.Font.Name = "Arial"
    Me.lbl_reloj.Font.Size = 13
    Do
        If EndTime - Now < 0 Then
            If hora = 0 And minu = 0 And segu = 0 Then
                minu = 45
            End If
            EndTime = Now + TimeSerial(hora, minu, segu)
        End If
        lbl_reloj = EndTime - Now
        [A2] = EndTime - Now
        lbl_reloj = [A2]
        lbl_reloj = Format([A2], "hh:mm:ss")
        tiempo = Split(lbl_reloj, ":")
        If tiempo(0) = "00" And tiempo(1) = "00" And tiempo(2) = "00" Then
            StopTimer = True
            MsgBox "el tiempo concluyó", vbExclamation, "RELOJ"
            Unload Me
        End If
        DoEvents
    Loop Until StopTimer
End Sub
'
Private Sub CommandButton2_Click()
    'Stops the timer
    StopTimer = True
End Sub
'
Private Sub CommandButton3_Click()
'Por.Dante Amor
    'reiniciar
    reiniciar = True
    CommandButton1_Click
End Sub
'
Private Sub CommandButton4_Click()
'Por.DAnte Amor
    'fin
    StopTimer = True
    Unload Me
End Sub
'
Private Sub UserForm_Click()
'Por.Dante Amor
    reiniciar = False
End Sub

'

¡Gracias! , excelente tu aporte.

DAM, noto que al detener el reloj y dejar pasar un corto lapso de tiempo, el mismo no reinicia exactamente donde había parado sino que reinicia como si hubiera avanzado el tiempo, ¿Qué podrá ser?

Saludos.

Te anexo el código actualizado. Prueba y me comentas

Dim StopTimer As Boolean
Dim reiniciar As Boolean
'
Private Sub CommandButton1_Click()
'Act.Por.Dante Amor
    'Start the timer
    Dim EndTime As Double
    StopTimer = False
    tiempo = Split(lbl_reloj, ":")
    If UBound(tiempo) < 2 Then
        reiniciar = False
    End If
    If reiniciar Then
        hora = tiempo(0)
        minu = tiempo(1)
        segu = tiempo(2)
        reiniciar = False
    Else
        hora = [B2]
        minu = [C2]
        segu = [D2]
    End If
    Me.lbl_reloj.Font.Name = "Arial"
    Me.lbl_reloj.Font.Size = 13
    Do
        If EndTime - Now < 0 Then
            If hora = 0 And minu = 0 And segu = 0 Then
                minu = 45
            End If
            EndTime = Now + TimeSerial(hora, minu, segu)
        End If
        lbl_reloj = EndTime - Now
        [A2] = EndTime - Now
        lbl_reloj = [A2]
        lbl_reloj = Format([A2], "hh:mm:ss")
        tiempo = Split(lbl_reloj, ":")
        If tiempo(0) = "00" And tiempo(1) = "00" And tiempo(2) = "00" Then
            StopTimer = True
            MsgBox "el tiempo concluyó", vbExclamation, "RELOJ"
            Unload Me
        End If
        DoEvents
    Loop Until StopTimer
End Sub
'
Private Sub CommandButton2_Click()
    'Stops the timer
    StopTimer = True
End Sub
'
Private Sub CommandButton3_Click()
'Por.Dante Amor
    'reiniciar
    reiniciar = True
    CommandButton1_Click
End Sub
'
Private Sub CommandButton4_Click()
'Por.DAnte Amor
    'fin
    StopTimer = True
    Unload Me
End Sub
'
Private Sub UserForm_Terminate()
'Por.DAnte Amor
    StopTimer = True
End Sub

S a l u d o s

¡Gracias! DAM, ya ví de donde proviene el inconveniente; es que una vez leí, que dentro de las buenas prácticas de programación está el declarar las variables y para asegurarse de ello se debe utilizar el "Option Explicit", ese efecto desagradable que te comenté se presenta a partir del momento en que agrego las siguientes líneas:

Option Explicit
Dim StopTimer As Boolean
Dim reiniciar As Boolean
Dim tiempo
Dim hora As Date, minu As Date, segu As Date
Dim EndTime As Double

Bueno, será entonces cambiar por los malos hábitos, Jajajajajaja.

Muchas gracias, igualmente el resultado es el esperado y el solicitado en la ayuda y en eso se concentraba mi llamado de auxilio.

Saludos.

Solamente para el conocimiento general.

En VBA, no es necesario declarar las variables, todas se declaran por default como Variant, sólo en algunos casos es necesario declararlas.

Se recomienda utilizar Option Explicit cuando tienes un programa extenso y tienes muchas variables, entonces si utilizas una variable en repetidas ocasiones de esa manera podrías evitar errores en la utilización del nombre de la variable.


En este programa, no es necesario, es muy pequeño y no tienes muchas variables.

Si quieres utilizar Option Explicit, entonces tienes que declarar las variables de manera correcta, de lo contrario podría presentar resultados inesperados.

Las variables hora, minu y segu son de tipo Integer, y las estás declarando como tipo Date.

La variable tiempo es un arreglo de tipo String, y no la estás declarando, al no declararla, entonces queda del tipo Variant; lo correcto sería:

Dim tiempo() As String

La declaración tiempo() significa que es un arreglo de strings, eso es lo que regresa la función Split:

tiempo = Split(lbl_reloj, ":")

En resumen, te recomiendo que no declares las variables, VBA lo hace por ti.


S a l u d o s . D a n t e   A m o r

P.d. Esta explicación, bien podría quedar en una nueva pregunta, para aclarar dudas sobre la declaración de variables del tipo arreglo.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas