Crear cronometro excel 2010
He estado intentando crear una macro para cronometrar con excel y no lo consigo, lo que necesitaría sería el cronometro en si, que cuando le de a un botón comience, con otro botón pare y con otro resetee a "0". También estoy intentando poner una casilla donde aparezca el tiempo acumulado. Agradecería mucho la ayuda ya que he estado buscando por la red y no encuentro la solución que encaje...
1 Respuesta
Estimado en www.programarexcel.blogspot.com existe un ejemplo que podrás descargar el cual se adapta a lo que tu quieres hacer, debes modificarlo un poco para que concuerde con lo que quieres hacer, fijate y comenta en que te puedo ayudar si no puedes implementar según lo que tu quieres hacer, el código sería:
Private Sub IniciaCron()
Actualiza hsini = Now
Sheets("hoja1").Range("f2").Value = FormatDateTime(hsini, vbLongTime)
Sheets("hoja1").Range("g2").Value = ""
End Sub
Completo lo verás en el ejemplo porque son varios códigos para que funcione, fijate en el ejemplo.
Esta bien, aunque lo que quiero no es que se me guarden todos los registros individualmente, sino tener una casilla donde este el cronometro (eso ya esta) y otra que me aparezca el valor acumulado total de todo el tiempo que ha estado ese cronometro corriendo, y eso es lo que no he visto en ninguna p´agina y tampococo consigo por mi cuenta.
Estaría muy agradecido si me pudieses solucionar eso....
Muchas gracias.
Private Sub StopCron()
FinCron
Dim UF As Long
Dim d1, d2, d3 As Date
With Sheets("hoja1")
.Range("g2").Value = FormatDateTime(Now(), vbLongTime)
.Range("h2").Value = FormatDateTime(.Range("g2") - .Range("f2"), vbLongTime)
UF = .[F1048576].End(xlUp).Row + 1
.Cells(UF, 6).Value = .[f2].Value
.Cells(UF, 7).Value = .[g2].Value
.Cells(UF, 8).Value = [h2].Value
.Range("f" & UF & ":h" & UF).NumberFormat = "h:mm:ss"
End With
d1 = Sheets("hoja1").Cells(2, 6).Value
d2 = Sheets("hoja1").Cells(UF, 8).Value
Sheets("hoja1").Cells(1, 1).Value = d1 - d2
d3 = Sheets("hoja1").Cells(1, 1).Value
d3 = FormatDateTime(d3, vbLongTime)
Sheets("hoja1").Cells(1, 1).Value = "Ha trascurrido " & d3 & " desde el inicio"Cambia esa parte del código ahí te totaliza lo que quieres, repregunta antes de puentuar me interesa que quedes satisfecho con la respuesta.
Muchas gracias por el esfuerzo puesto, esa es la idea que quiero pero no salen bien los datos, cuando empiezo en 9:10:00 y acabo 9:10:10 por ejemplo, me aparece, Ha transcurrido 09:09:50 desde el inicio. Y si le vuelvo a dar a iniciar y luego a detener, suma el tiempo en el que ha estado pausado el cronometro también. Muchas gracias de antemano.
Saludos,
He logrado hacer un apaño con lo que me dijiste, muchas gracias (aunque aquí no se entiende mucho.)
Option Explicit
Dim dtHoraSiguiente, dtInicioCrono As Date
Sub PararReloj() Application.ScreenUpdating = False 'Desactivar el evento Ontime On Error Resume Next Application.OnTime dtHoraSiguiente, "ActualizarHora", , False End Sub
Sub ActualizarHora() 'Poner la hora en una celda Worksheets("Hoja1").Range("D12").Value = Now - Worksheets("Hoja1").Range("B12").Value 'Lanzar el siguiente evento 1 segundo después dtHoraSiguiente = Now + (1 / 86400) Application.OnTime dtHoraSiguiente, "ActualizarHora"
End Sub
Sub LanzarCrono()
ActualizarHora
dtInicioCrono = Now Worksheets("Hoja1").Range("B12").Value = FormatDateTime(dtInicioCrono, vbLongTime) Worksheets("Hoja1").Range("C12").Value = "" Range("A12").Select ActiveCell.FormulaR1C1 = "=NOW()" Selection.NumberFormat = "m/d/yyyy"
End Sub
Sub PararCrono()
PararReloj
Dim lngÚltimaFila As Long
With Worksheets("Hoja1") .Range("C12").Value = FormatDateTime(Now(), vbLongTime) .Range("D12").Value = FormatDateTime(.Range("C12") - .Range("B12"), vbLongTime) lngÚltimaFila = .[B65536].End(xlUp).Row + 1 .Cells(lngÚltimaFila, 2).Value = .[B12].Value .Cells(lngÚltimaFila, 3).Value = .[C12].Value .Cells(lngÚltimaFila, 4).Value = .[D12].Value .Cells(lngÚltimaFila, 1).Value = .[A12].Value .Range("B" & lngÚltimaFila & ":D" & lngÚltimaFila).NumberFormat = "h:mm:ss" .Range("A" & lngÚltimaFila).NumberFormat = "m/d/yyyy"
End With
Range("D16").Select ActiveCell.FormulaR1C1 = "=R[-4]C" Range("D16").Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D17").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=RC[-1]" Range("D17").Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("C17").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=R[-1]C[1]+RC[1]" Range("C17").Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D17").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=R[-1]C" Range("D17").Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub
