Notifications
Clear all

Cronometro

4 Posts
3 Usuários
0 Reactions
1,036 Visualizações
(@leandrobjl)
Posts: 5
Active Member
Topic starter
 

Olá galera estou precisando de ajuda.

Preciso de um cronometro que posso para iniciar rapidamente e o valor do tempo ir pra uma determinada celula, tipo pra marcar posse de bola.....

 
Postado : 06/08/2013 7:59 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

De uma olhada neste Tópico : viewtopic.php?f=10&t=4620&hilit=tempo&start=10

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 07/08/2013 7:10 am
(@pedro)
Posts: 362
Reputable Member
 

Bom dia!

Leandrobjl, neste outro tópico este tema foi discutido e houveram diversas sugestões.

Outros membros mais experientes postaram diferentes modelos de cronômetro, pesquise se algum deles te serve:

viewtopic.php?f=10&t=4620

Caso lhe atenda, não esqueça de marcar o tópico como resolvido.
Qualquer coisa pode se basear em um dos modelos para solicitar alguma adaptação que não saiba fazer.

Sds. Pedro Júnior

 
Postado : 07/08/2013 7:26 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Favor usar a pesquisa do fórum!!

Tente adaptar..
Fonte:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=242

Public stopMe As Boolean 
Public resetMe As Boolean 
Public myVal As Variant 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    If Target.Column = 1 Then 
        If Target.Value = myVal And Target.Value <> "" Then 
             'Changed
            Dim startTime, finishTime, totalTime, timeRow 
            startTime = Timer 
            stopMe = False 
            resetMe = False 
            myTime = Target.Offset(, 2).Value 
            Target.Offset(, 1).Select 
startMe: 
            DoEvents 
            timeRow = Target.Row 
            finishTime = Timer 
            totalTime = finishTime - startTime 
            Target.Offset(, 1).Value = Format(myTime + totalTime, "0.0000") & " Seconds" 
            If resetMe = True Then 
                Target.Offset(, 1).Value = 0 
                Target.Offset(, 2).Value = 0 
                stopMe = True 
            End If 
            If Not stopMe = True Then 
                Target.Offset(, 2).Value = totalTime 
                Goto startMe 
            End If 
            Cancel = True 
            End 
        Else 
             'Not Changed
            stopMe = True 
            Cancel = True 
        End If 
    End If 
End Sub 
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    myVal = Target.Value 
End Sub 

Ex2

Option Explicit

Dim StopTimer As Boolean
Dim Etime As Single
Dim Etime0 As Single
Dim LastEtime As Single
Dim lapnr As Integer
Private Sub ExitBtn_Click()
StopTimer = True
Unload Me
End Sub
Private Sub ResetBtn_Click()
StopTimer = True
Etime = 0
Etime0 = 0
LastEtime = 0
ElapsedTimeLbl.Caption = "00:00:00.00"
End Sub

Private Sub StartBtn_Click()
StopTimer = False
Etime0 = timer() - LastEtime
Me.Repaint

    Do Until StopTimer
    Etime = Int((timer() - Etime0) * 100) / 100
        If Etime > LastEtime Then
        LastEtime = Etime
        ElapsedTimeLbl.Caption = Format(Etime / 86400, "hh:mm:ss.") & Format(Etime * 100 Mod 100, "00")
        DoEvents
        End If
    Loop

End Sub
Private Sub StopBtn_Click()
StopTimer = True
Laplbl = ""
Beep
End Sub

Private Sub LapBtn_click()
Laplbl.Caption = ElapsedTimeLbl
lapnr = lapnr + 1
Range("A" & lapnr) = "lap " & lapnr
Range("B" & lapnr) = ElapsedTimeLbl
End Sub
Private Sub UserForm_Activate()
Range("A:B") = ""
ElapsedTimeLbl = "00:00:00.00"
End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 07/08/2013 9:24 am