Timer

 

Home
Nach oben

Last Update 20.07.2004

Copyright  2003
Ramses (C)

 

Step Down Timer = Misst in Sekundenabständen die abgelaufene Zeit und sperrt nach abgelaufener Zeit die Arbeitsmappe vor weiteren Eingaben

 


 

 

Dieser Code wurde für eine Prüfmappe entwickelt.

In A1 steht die gesamte Zeitdauer, in A2 wird die Restzeit geschrieben.

Der Ablauf kann mit einem Button angehalten werden ( Zuweisung: Sub StopStepDownTimer()) . Bei erneutem Klick auf den Button wird der Ablauf erneut gestartet und bei der vorher abgelaufenen Zeit fortgesetzt.

 

'In das Klassenmodul "Diese Arbeitsmappe"

Sub Workbook_Open()

Worksheets("Test").Range("A1") = "00:10:00"

StopStepDown = False

End Sub

 

'In ein Modul

Option Explicit

Public StopStepDown As Boolean

 

Sub StopStepDownTimer()

If StopStepDown = True Then

          StopStepDown = False

Else
         
StopStepDown = True

          StepDownTimer

End Sub

 

 

Sub StepDownTimer()

Dim i As Integer

Dim Start, Step, Waittime, TimerTest

'Variable für Timerlauf definieren

StopStepDown = True

'Startzeit

Start = Range("a1")

'Sekunde zum Rückwärtszählen berechnen

'Das muss ich so rechnen, bei 1/(24*3600) erhalte ich einen Überlauffehler

'Keine Ahnung warum

Step = 1 / 24

Step = Step / 60

Step = Step / 60

'Prüfen ob der Timer vorher gestoppt wurde

TimerTest = Range("A2").Value

'Beim ersten Start die PrüfSequenz überspringen

If TimerTest = vbNullString Then

         GoTo ErsterStart

End If

'Variablenformat ändern für Prüfung

TimerTest = TimeValue(Format(Range("A2").Value, "hh:mm:ss"))

If TimerTest > TimeValue("00:00:00") Then

      'Variable Start mit Restzeit füllen

      Start = Range("a2")

      For i = 1 To Start / Step

           'Aktionen erlauben

           DoEvents

           'Zwischenstop abfragen

           If StopStepDown = False Then

                    Exit Sub

           End If

          'Wartezeit immer wieder neu berechnen

          Waittime = TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 1)

          'Application anhalten

          Application.Wait Waittime

          'neuen Wert in Zelle schreiben

          If Range("a2").Value - Step = Step Or Range("a2").Value = 0 Then

                  Range("a2").Value = 0

                  Exit Sub

          Else

                  Range("a2").Value = Range("a2").Value - Step

          End If

      Next i

      Exit Sub

End If

ErsterStart:

'1. Sekunde abziehen

Range("a2").Value = Start - Step

'Anzahl der Schleifen berechnen

For i = 1 To Start / Step - 1

         'Aktionen erlauben

         DoEvents

         'Zwischenstop abfragen

         If StopStepDown = False Then

                    Exit Sub

         End If

         'Wartezeit immer wieder neu berechnen

         Waittime = TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 1)

          'Application anhalten

          Application.Wait Waittime

          'neuen Wert in Zelle schreiben

           If Range("a2").Value - Step = Step Or Range("a2").Value = 0 Then

                       Range("a2").Value = 0

                       Worksheets("Test").Protect Password:="Schutz"

                       Exit Sub

           Else

                       Range("a2").Value = Range("a2").Value - Step

           End If

Next i

End Sub