martes, 23 de julio de 2013

VBA: La macro de un cronómetro en Excel.

Hace bastante tiempo tenía ganas de exponer este sencillo uso del método OnTime (que ya vimos en el pasado ver OnTime). Recientemente un usuario me preguntaba sobre un modelo similar y recordé que lo tenía pendiente...
En el día de hoy aplicaremos este método en la construcción de un sencillo cronómetro, con un botón de Inicio y otro de Paro. Con la combinación de cuatro procedimientos (muy cortos), basados en el método OnTime, conseguiremos iniciar un cronómetro por segundos. Veamos en la imagen su funcionamiento:

VBA: La macro de un cronómetro en Excel.


Vemos dos botones a los que he llamado 'Lanzar contador' y 'Parar contador', a los cuales he asociado los procedimientos Sub 'InicioContador' y 'ParaContador' respectivamente, y que veremos a continuación.

En un módulo del Editor de VBA añadiremos las líneas de nuestra macro.

Option Explicit
Dim SegundoSiguiente As Date, ComienzaContador As Date

Sub ParaReloj()
    On Error Resume Next
    'con OnTime programamos la ejecución de un procedimiento en un momento concreto
    'en concreto, al parar desactivamos el evento Ontime
    Application.OnTime SegundoSiguiente, "ActualizaReloj", , False
End Sub

Sub ActualizaReloj()
    'Ponemos el tiempo transcurrido en la celda C2
    Worksheets("Tiempo").Range("C2").Value = Now - Worksheets("Tiempo").Range("A2").Value
    'Lanzar el siguiente evento 1 segundo después (total seg dia = 86.400 = 60seg x 60min x 24hrs)
    SegundoSiguiente = Now + (1 / 86400)
    
    'Programa la ejecución de un procedimiento a una hora especificada,
    'ya sea a una hora específica o después del transcurso de un período de tiempo específico
    'expresión.OnTime(EarliestTime, Procedure, LatestTime, Schedule)
    Application.OnTime SegundoSiguiente, "ActualizaReloj"
End Sub

Sub InicioContador()
    'llamamos al procedimiento ActualizaReloj, es decir, comenzamos la cuenta de segundos...
    ActualizaReloj
    ComienzaContador = Now
    'con FormatDateTime y vbLongTime damos formato de fecha según configuración equipo
    Worksheets("Tiempo").Range("A2").Value = FormatDateTime(ComienzaContador, vbLongTime)
    'limpiamos la celda B2
    Worksheets("Tiempo").Range("B2").ClearContents
End Sub

Sub ParaContador()
    'detenemos el proceso ActualizaReloj, llamando al procedimiento ParaReloj
    ParaReloj
    'calculamos el tiempo transcurrido una vez parado el tiempo.
    
    'con FormatDateTime y vbLongTime damos formato de fecha según configuración equipo
    Worksheets("Tiempo").Range("B2").Value = FormatDateTime(Now(), vbLongTime)
    Worksheets("Tiempo").Range("C2").Value = _
    FormatDateTime(Worksheets("Tiempo").Range("B2") - Worksheets("Tiempo").Range("A2"), vbLongTime)
End Sub



Como se puede observar los procedimientos Sub 'ActualizaReloj' y 'ParaReloj' son los encargados de incrementar el temporizador (el cronómetro) de segundo en segundo y de pararlo. El resto de procedimientos se encargan principalmente de asignar formatos...

36 comentarios:

  1. estoy tratando de incorporar el código del cronometro pero no me funciona

    ResponderEliminar
    Respuestas
    1. Hola Nestor,
      debes asegurarte de seguir los pasos tal cual aparecen en la explicación...

      En todo caso, ¿cuál es el error que te aparece?

      Saludos

      Eliminar
  2. veo que se maneja una expresión que se llama "Tiempo". esa esta asignada a laguna tabla o lugar de la hoja de excel. o aque te refieres con tiempo. al usa la expresion Worksheets("Tiempo").Range("C2").Value es que el libro de nombre tiempo en el rango C2. ??????

    ResponderEliminar
    Respuestas
    1. Hola Jesús,
      en este caso 'tiempo' es el nombre de la Hoja sobre la que trabajo.
      ;-)
      Slds

      Eliminar
  3. Al depurar me devuelve el valor de Now como dd/mm/aa hh/mm/ss sobre las Celda C2 no se si por eso no continué la macro

    ResponderEliminar
    Respuestas
    1. Now es el equivalente a la función AHORA(), y por tanto es normal me devuelva el día, mes, año, hora, minuto y segundo.. de hecho, eso se pretende para poder controlar el tiempo pasado

      Saludos!

      Eliminar
  4. Hola buenas, gracias por el cronómetro está muy chulo, aunque tengo problemas para recrearlo.

    Verás, he copiado el código y he adaptado el nombre de la hoja, pero al iniciar la macro solo me sale el tiempo de inicio y un montón de asteriscos en la columna tiempo transcurrido. Como puedo hacerlo para que me salga como el ejemplo de arriba

    ResponderEliminar
    Respuestas
    1. Hola Daniel, realmente sólo necesitas una hoja de cálculo que se llame 'Tiempo' o adecuar el código al nombre de tu hoja, y copiar y pegar el código de arriba en un módulo estándar del proyecto VBA (en el editor de VB).

      Que te aparezcan asteríscos es muy raro??.. quizá almohadillas # por que le ancho de la columna no sea suficiente....??

      Eliminar
    2. Perdón, si son almohadillas, a veces me da por confundirlos jejeje

      intentaré hacer lo que dices a ver si ahora tira

      Una pregunta, sería posible que al pulsar el inicio hiciera una cuenta atrás?

      Me refiero a algo así como 3....2....1.... y al hacer 0 que lanzara el contador

      Gracias por responder

      Eliminar
    3. Hola Daniel,
      la cuenta atrás si sería posible... habría que fijar un momento del tiempo e ir restando a ese tiempo fijo, segundo a segundo...
      Saludos

      Eliminar
  5. Hola, copie el codigo pero cuando ejecuto el boton inicio, en la celda A1 me pone la hora de inicio, pero en la C1 tambien me pone esa hora, luego muestra un mensaje: no puede correr la macro "nombre_de_archivo.xlsm´!actualizaReloj´
    al darle ok, asi se quedan ambas celdas, luego al darle detener, si me muestra el tiempo transcurrido en C1 y la hora ala que se detuvo en B1, por lo que me gustaria poder ver en la celda C1 el tiempo cuando esta transcurriendo.
    gracias

    ResponderEliminar
    Respuestas
    1. Hola Ricardo,
      asegúrate que el código es tal cual se expone... y que cumple la condición de tener una hoja llamada 'Tiempo' (o ajustar el código a tu situación); tendrías que ver lo que se visualiza en la imagen del inicio...

      Eliminar
  6. ¿Hola, que tal? Mira estoy intentando hacer una función que haga una cuenta atrás

    aquí te dejo la función


    Sub Funcion1 ()

    dim RF as date

    '4 seg para la cuenta atrás
    RF = "00:00:04"

    for x = 1 to 4

    'Va restando segundos
    RF = RF - TimeValue("00:00:01")
    Beep

    Next x

    Hará una cuenta atrás hasta que llegue al fin del for. y en cada interacción, soltará un beep. El problema está en que esto lo hace automáticamente (Suelta los 4 beeps de golpe) y no hace la cuenta atrás, a no ser que se pare con un msgbox, pero eso no me valdría porque para que continue se debe pulsar el Aceptar para la siguiente interacción.

    ¿Habría alguna forma de hacerlo?

    Gracias por contestar

    ResponderEliminar
    Respuestas
    1. Hola Daniel,
      prueba añadiendo un temporizador
      Sub Funcion1()

      Dim RF As Date

      '4 seg para la cuenta atrás
      RF = "00:00:04"
      Cells(1, 1).Value = TimeValue(RF)
      For x = 1 To 4
      Application.Wait (Now + TimeValue("00:00:01"))
      'Va restando segundos
      RF = TimeValue(RF) - TimeValue("00:00:01")

      Beep
      Cells(1, 1).Value = RF

      Next x
      End Sub

      Saludos

      Eliminar
    2. Gracias funciona de forma cojonuda, me gustaría hacer un par de preguntas

      ¿Habría alguna forma (Teniendo en cuenta esta función) de poder añadir milesimas de segundo?

      y la segunda es, se podría hacer un timer que solo sumara hasta los minutos?

      me refiero a:

      cuando llegara al 59 minutos 59 segundos (59:59) que el siguiente segundoenvez de ser 1:00:00 que sea 60:00 y así consecutivamente.

      Gracias por tu ayuda

      Eliminar
    3. Gracias,
      escribiré, en cuanto pueda un post al respecto.
      Un saludo

      Eliminar
  7. Este comentario ha sido eliminado por el autor.

    ResponderEliminar
  8. hola buenas, viendo y utilizando en codigo de arriba, he podido crear "una cuenta atrás" aquí dejo el código:

    Sub CuentaAtras()

    Dim x As Integer
    Dim y As Integer

    For y = 1 To 5

    Hoja1.cuenta.Caption = x

    x = x - 1

    Application.Wait (Now + TimeValue("00:00:01"))

    Beep

    If y = 4 Then

    Hoja1.cuenta.Caption = "falta 1 segundo"

    y = y + 1

    Beep

    End If

    Next y

    Hoja1.cuenta.Caption = "Activado"

    End Sub

    el problema es que la label, solo cambia de valor (caption) cuando está fuera del bucle, lo he hecho sin el bucle pero el beep solo suena una vez.

    que puedo hacer para que funcione el cambio de label y lo del beep?

    gracias amigo

    ResponderEliminar
  9. perdón, x = 5, se me olvidó teclearlo.

    Perdona el doble post.

    ResponderEliminar
    Respuestas
    1. Hola Rubanik,
      esto podría ser una solución
      Sub CuentaAtras()
      Dim x As Integer
      Dim y As Integer
      x = 5
      For y = 1 To 5
      Hoja1.cuenta.Caption = x
      For i = 1 To 300
      DoEvents
      Next i

      x = x - 1
      Application.Wait (Now + TimeValue("00:00:01"))
      Beep
      If y = 4 Then
      Hoja1.cuenta.Caption = "falta 1 segundo"
      y = y + 1
      Beep
      End If
      Next y

      Hoja1.cuenta.Caption = "Activado"

      End Sub

      En negrita el ajuste.... incluye un 'retraso' para que no vaya tan rápido...
      Saludos

      Eliminar
  10. funciona de maravilla, gracias compañero

    si me permites, me gustaría hacerte una pregunta,

    ¿como se puede modificar la frecuencia del beep para que suene más agudo?

    ResponderEliminar
    Respuestas
    1. Hola,
      no es posible configurar el Beep... en todo caso tendrías que emplear otro tipo de sonidos empleando API's:
      http://excelforo.blogspot.com.es/2013/12/vba-emitiendo-sonidos-desde-vba-en-excel.html
      Un saludo

      Eliminar
  11. Probaré lo de las api's a ver que tal

    Muchas gracias por tu ayuda

    ResponderEliminar
  12. Saludos Ismael, al parecer el código funciona muy bien en Excel 2003, pero el error a la versión 2007, debido a que se debe darle formato a la celda como: Range("A2").Value = Format(VBA.Now, "hh:mm:ss;@") en la subrutina Sub ActualizaReloj() , lo otro es que el código corre los segundos es en A2 y no en C2 "Tiempo transcurrido"

    ResponderEliminar
    Respuestas
    1. Hola,
      revisa lo que estás haciendo y hayas copiado, por que el código está desarrollado en versión 2013 y funciona tal cual ves en el vídeo primero....
      ???
      Saludos

      Eliminar
  13. bien Ismael, el código lo copie tal cual como esta, pero en fin, ya con el formato Format(VBA.Now, "hh:mm:ss;@"), lo solucione, lo que me interesa es llevar este conteo a un formulario en VBA, pero no he encontrado un código que me actualice el label en tiempo real, con la celda que cambia automáticamente en la hoja de Excel. Gracias.

    ResponderEliminar
    Respuestas
    1. Personalmente no te recomiendo añadir a un UserForm el sistema, ya que aunque es el mismo que en la hoja de cálculo, se produce una ralentización en todo el formulario que incluso provoca en ocasiones el fallo del modelo y salta un error a depurar...

      Eliminar
  14. Buenas noches, como esta?... tengo una duda, ya tengo un formato montado por la empresa donde trabajo y necesito llevar un control mas exacto del tiempo que se consumo durante cada proceso en los distintos productos que se realizan en la empresa. LLevando un control de las paradas operativas y mecanicas y a su vez con mayor exactitud el tiempo efectivo que se viene de la resta de la hora inicial a la hora final.

    Estoy siguiendo los pasos tal cual bien explica, pero me marca error con respecto a

    Sub ActualizaReloj()
    'Ponemos el tiempo transcurrido en la celda H14
    Worksheets("lunes").Range("H14").Value = Now - Worksheets("lunes").Range("F14").Value
    'Lanzar el siguiente evento 1 segundo después (total seg dia = 86.400 = 60seg x 60min x 24hrs)
    SegundoSiguiente = Now + (1 / 86400)

    cuando le doy inicio. ¿que hago? lo mismo me pasa al darle parar. ayudame porfa

    ResponderEliminar
    Respuestas
    1. Hola Yezid,
      no veo ningún fallo.. si la hoja 'lunes' existe y has replicado los pasos de las cuatro macros (OJO debes lanzar y parar ejecutando 'InicioContador' y 'ParaContador' respectivamente!!!), debe funcionarte...
      REvisa los pasos y si sigue con error puedes enviarme el fichero a
      excelforo@gmail.com
      Saludos

      Eliminar
    2. Me imagino que seria creando varios modulo en la misma hoja pero como hago eso?

      Eliminar
    3. Y la verdad o entiendo que ocurre, estoy siguiendo los pasos como se deben y no me transcurre el tiempo en mi celda de tiempo transcurrido. le pasare la hora via mail

      Eliminar
    4. Hola,
      he probado sobre tu fichero, en la hoja LUNES y funciona perfectamente...
      sólo he tenido que cambiar el formato de las celdas a formato HORA.
      Saludos

      Eliminar
    5. Hola, confiro deacuerdo lo intentare a ver que ocurre. Gracias

      Eliminar
  15. Hola Sr. Ismael, ok gracias lo intentare. Por que lo que mas me gustaría es que tenga continuidad, me explico desearía es que el cronometro me trabaje en mi plantilla para cada turno y area de la empresa. Donde por ejemplo el producto A1 comenzó a las 7:00 entonces transcurra el tiempo cuando le de parar me ejecute mi hora final como bien usted lo ejecuta, pero luego cuando vaya iniciar el producto A2 inicie desde la hora que termino el producto A1 y asi se siga el mismo comportamiento para las demás productos sin que me borre las horas para poder llevar un control de mi tiempo efectivo. Como podría hacer eso?

    ResponderEliminar
    Respuestas
    1. Esto es algo más complicado, tendrías que realizar un bucle que tenga en cuenta los últimos tiempos de los productos anteriores...

      Eliminar
    2. No tiene algún formato con el que pueda guiarme, es que me urge... se lo agradeceria muchisimo

      Eliminar