Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
352to356
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
352to356
352to356
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

ablaufendes zeitmakro???

ablaufendes zeitmakro???
20.12.2003 14:53:53
Jürgen
Hallo Leute,

wer kann mir helfen, ich habe mir ein tipprogramm entworfen und möchte nun das auf der hauptseite sagen wir mal in zelle a1 ein makro ablaufen soll das jeweils tage ,stunden, minuten herunterzählt bis zum nächsten Spieltag 15:30. wenn der spieltag um 15:30 erreicht ist soll er wieder die zeit bis zum nächsten spieltag anzeigen, das ganze dann für 34 Spieltage.
Das ganze soll dann ungefähr so aussehen:

Noch 3 tage, 5 Sunden, 5 Minuten bis zum nächsten Spieltag

ist dieses irgendwie zurealisieren??????

Wäre erfreut wenn mir jemand dabei helfen könnte..

Danke euch im vorraus.

Jürgen

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ablaufendes zeitmakro???
20.12.2003 17:34:03
Reinhard
Hi Jürgen,
Die Makros erwarten die Spieltabelle in Tabelle2 in Spalte A, also dort manuell oder per Aufruf vom Makro SpielTageErzeugen()
die Spieltage dort zeitlich nach unten sortiert eintragen.
Gestartet wird dann das Ganze durch Aufruf von Makro Start()
Gruß
Reinhard

Sub Start()
While Second(Now) <> 0
'Warten bis Minute hochzählte
Wend
DiffZeit
zaehl
End Sub
Sub zaehl()
Application.OnTime Now + TimeValue("00:01:00"), "DiffZeit"
End Sub
Sub DiffZeit()
Zeile = 1
'While Now > Worksheets("Tabelle2").Cells(Zeile, 1) _
'                                           And Worksheets("Tabelle2").Cells(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("n", Now, Worksheets("Tabelle2").Cells(Zeile, 1)) + 60 * 15 + 30
Tage = Int(MinDiff / 24 / 60)
MinDiff = MinDiff - Tage * 24 * 60
Stunden = Int(MinDiff / 60)
MinDiff = MinDiff - Stunden * 60
Worksheets("Tabelle1").Range("A1") = Tage & " Tage " & Stunden & " Stunden " & MinDiff & " Minuten"
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

Anzeige
AW: ablaufendes zeitmakro???
20.12.2003 18:34:07
Jürgen
Hallo Rainer

Danke dir für deine promte Antwort, so wie ich es sehe muss ich das makro immer neu starten wenn ich die genaue zeitperiode sehen will, das möchte ich eigentlich nicht! ich möchte das wenn ich im Hauptmenue bin das es wie eine uhrzeit aussieht die automatisch ( immer wenn ich im Hauptmenie bin soll es starten) abläuft Tage Std. Min. und hab ich vergessen sec. soll dann so aussehen 00Tag:00Std:00Min:00sec. Vieleicht habe ich mich ein wenig falsch ausgedückt, entschuldigung. Kannst du mir dabei nochmals helfen?

Tausend dank im vorraus

mfg
Jürgen
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

Anzeige
AW: ablaufendes zeitmakro???
21.12.2003 17:02:14
Jürgen
alles klar Reinhard hat wunderbar geklappt danke dir

Jürgen
thanks for feedback o.w.T.
21.12.2003 17:11:15
Reinhard
.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige