Stop klocka till XL

[hagge69]

Jag håller på och gør ett registrerings program før handboll.

Till detta behøver jag en tids klocka som ræknar upp till tex 30 min (valbart).

Nær man stoppar tiden måste den fortsætta från den tid den blev stoppad på.

Er detta møjligt i XL?

 

 

Vældigt tacksam før ett svar

 

Steffen

 

[Monshi]

Tror detta tips från XLdennis kan vara aktuellt att starta ifrån:

http://www.xldennis.com/klockan(vba).htm

 

 

/T

 

Even when we know we´ll never find the answers, we have to keep on asking questions.

 

[hagge69]

Tack för svar men problemet är att jag inte kan så mycket om programmering.

Jag kollade linken du gav mej men den fungerar inte riktigt så som jag vill.

Problemet är att den startar från nutid och när man stoppar och startar den så fortsätter den inte från var den blev stoppad utan den går till nutid.

 

[Monshi]

Visst är det så, men det är en grund att utgå ifrån.

 

Här får du en lätt modifierad kod som räknar sekunder från start upp till 30 minuter varefter den stannar.

 

Notera dock att detta är inte en optimal lösning. Excel multitaskar inte. Application.OnTime-rutinen körs enbart om Excel inte är upptaget med annat som exempelvis inmatning av data. Det går inte att helt garantera att det är exakt 30 minuter som gått.

 

Jag skulle nog egentligen rekommendera dig att se om det inte finns annat, färdigt, program för detta. Torde inte vara så svårt att skapa exempelvis en applikation i .Net-miljön eller Java för detta.

 

Koden ovan kan kompletteras/styras via knappar på arbetsbladet som starta/stoppar/återställer klockan. Koden bör även uppdateras med With-satser som adresserar det blad som klockan ska skrivas på, kanske bäst via en namngiven referens till den cell klockan ska skrivas på.

 

 

Public KörNär As Double
Dim lastTime As Date
'------------------------------------------
Sub StartaKlockan()
With Range("A1")
           lastTime = Now
          ' .Value = timeValue
           .NumberFormat = "hh:mm:ss"
End With

'Här tilldelas den publika variabeln ett tidsvärde
KörNär = Now + TimeSerial(0, 0, 1)

'Här anropas UppdateraKlockan
Application.OnTime earliesttime:=KörNär, _
procedure:="UppdateraKlockan", schedule:=True
End Sub

Sub Reset()
   With Range("A1")
       .Value = 0
       lastTime = Now
   End With

End Sub

Sub UppdateraKlockan()
With Range("A1")
   If .Value + (Now - lastTime) >= TimeSerial(0, 30, 0) Then
       .Value = TimeSerial(0, 30, 0)
       Exit Sub
   End If



      .Value = .Value + (Now - lastTime)
      lastTime = Now
      .NumberFormat = "hh:mm:ss"


       KörNär = Now + TimeSerial(0, 0, 1)

       Application.OnTime earliesttime:=KörNär, _
       procedure:="UppdateraKlockan", schedule:=True

End With

End Sub


Sub StoppaKlockan()
'Genom att tilldela parametern "schedule" värdet Falskt så
'stoppas klockan.
Application.OnTime earliesttime:=KörNär, _
procedure:="UppdateraKlockan", schedule:=False
End Sub

 

 

/T

 

Even when we know we´ll never find the answers, we have to keep on asking questions.

 

[hagge69]

Ok tack för detta.

 

[Jonny kovacs]

Visst är det så, men det är en grund att utgå ifrån.

 

Här får du en lätt modifierad kod som räknar sekunder från start upp till 30 minuter varefter den stannar.

 

Notera dock att detta är inte en optimal lösning. Excel multitaskar inte. Application.OnTime-rutinen körs enbart om Excel inte är upptaget med annat som exempelvis inmatning av data. Det går inte att helt garantera att det är exakt 30 minuter som gått.

 

Jag skulle nog egentligen rekommendera dig att se om det inte finns annat, färdigt, program för detta. Torde inte vara så svårt att skapa exempelvis en applikation i .Net-miljön eller Java för detta.

 

Koden ovan kan kompletteras/styras via knappar på arbetsbladet som starta/stoppar/återställer klockan. Koden bör även uppdateras med With-satser som adresserar det blad som klockan ska skrivas på, kanske bäst via en namngiven referens till den cell klockan ska skrivas på.

 

 

Public KörNär As Double
Dim lastTime As Date
'------------------------------------------
Sub StartaKlockan()
With Range("A1")
            lastTime = Now
           ' .Value = timeValue
            .NumberFormat = "hh:mm:ss"
End With

'Här tilldelas den publika variabeln ett tidsvärde
KörNär = Now + TimeSerial(0, 0, 1)

'Här anropas UppdateraKlockan
Application.OnTime earliesttime:=KörNär, _
procedure:="UppdateraKlockan", schedule:=True
End Sub

Sub Reset()
    With Range("A1")
        .Value = 0
        lastTime = Now
    End With

End Sub

Sub UppdateraKlockan()
With Range("A1")
    If .Value + (Now - lastTime) >= TimeSerial(0, 30, 0) Then
        .Value = TimeSerial(0, 30, 0)
        Exit Sub
    End If
    
        
        
       .Value = .Value + (Now - lastTime)
       lastTime = Now
       .NumberFormat = "hh:mm:ss"

   
        KörNär = Now + TimeSerial(0, 0, 1)
    
        Application.OnTime earliesttime:=KörNär, _
        procedure:="UppdateraKlockan", schedule:=True
    
End With

End Sub


Sub StoppaKlockan()
'Genom att tilldela parametern "schedule" värdet Falskt så
'stoppas klockan.
Application.OnTime earliesttime:=KörNär, _
procedure:="UppdateraKlockan", schedule:=False
End Sub

/T

 

Even when we know we´ll never find the answers, we have to keep on asking questions.

 

Detta fungerar perfekt för mig tusen tack