AW: ablaufendes zeitmakro???
20.12.2003 20:32:14
Reinhard
Hallo Jürgen,
nein , Start wird nur einmal gestartet, ruft dann Zaehl auf dass sich dann gegenseitig mit Zeitdiff aufruft,
letzlich endlos.
So, habs jetzt umgeschrieben auf Sekunden und es startet sich jetzt vollautomatisch wenn du Tabellenblatt1
aktivierst.
Beachte bite die Hinweise wo die Makros stehen müssen.
Wenn Du
Worksheets("Tabelle1").Range("A1") = Ausgabetext
durch
Application.StatusBar = Ausgabetext
ersetzst, oder wie hier im Code das " ' " dementsprechend änderst erfolgt die Ausgabe unten in der Statusleiste.
Gruß
Reinhard
Diese beiden Makros in das Modul Tabelle1 reinkopieren:
Private Sub Worksheet_Activate()
ZeitZählen = True
Zaehl
End Sub
Private Sub Worksheet_Deactivate()
ZeitZählen = False
Application.StatusBar = False
End Sub
Und diesen Code dann in das Modul Modul1:
Public ZeitZählen As Boolean
Sub Zaehl()
If ZeitZählen = True Then Application.OnTime Now + TimeValue("00:00:01"), "DiffZeit"
End Sub
Sub DiffZeit()
Zeile = 1
While DateSerial(Year(Now), Month(Now), Day(Now)) > Worksheets("Tabelle2").Cells(Zeile, 1) _
And Worksheets("Tabelle2").Cells(Zeile, 1) <> ""
Zeile = Zeile + 1
Wend
If DateSerial(Year(Now), Month(Now), Day(Now)) = Worksheets("Tabelle2").Cells(Zeile, 1) Then
If Time >= "15:30" Then Zeile = Zeile + 1
End If
If Worksheets("Tabelle2").Cells(Zeile, 1) = "" Then
MsgBox "Liste in Tabelle2 überprüfen"
End
End If
MinDiff = DateDiff("s", Now, Worksheets("Tabelle2").Cells(Zeile, 1)) + 55800
Tage = Int(MinDiff / 86400)
MinDiff = MinDiff - Tage * 86400
Stunden = Int(MinDiff / 3600)
MinDiff = MinDiff - Stunden * 3600
Minuten = Int(MinDiff / 60)
MinDiff = MinDiff - Minuten * 60
Ausgabetext = Format(Tage, "00") & "Tage" & Format(Stunden, "00") & "Std" _
& Format(Minuten, "00") & "Min" & Format(MinDiff, "00") & "Sek"
Worksheets("Tabelle1").Range("A1") = Ausgabetext
'Application.StatusBar = Ausgabetext
Call Zaehl
End Sub
Sub SpieltageErzeugen()
Set WS = Worksheets("Tabelle2")
WS.Range("A1").FormulaR1C1 = "12/20/2003"
WS.Range("A2").FormulaR1C1 = "12/27/2003"
WS.Range("A1:A2").AutoFill Destination:=WS.Range("A1:A50"), Type:=xlFillDefault
End Sub