Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 21:55:37
Preiserhöhung über mehrere Jahre berechnen
17.04.2024 20:19:32
Endzeitpunkt berechnen aus d:hh:mm errechnen
17.04.2024 18:57:33
Errinnerungsfunktion
17.04.2024 16:56:58
Stunden addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1304to1308
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1304to1308
1304to1308
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Countdown ergänzen

Countdown ergänzen
18.03.2013 20:26:24
Erwin
Hallo Excelspezialisten,
ich habe eine UF mit Countdown gefunden, die zwar funktioniert, die ich aber gerne anpassen würde, wenn ich es selbst könnte.
https://www.herber.de/bbs/user/84432.xlsm
Der "Start" Button funktioniert, die anderen (Stop, Weiter u. Reset) gibt es im Original nicht, aber die wollte ich ganz gerne eingebaut haben. Dafür habe ich mit meinen wenigen Kenntnissen schon mal die CommandButtons in die UF reingemacht - nur der Code fehlt noch.
MUST have...
Stop: der countdown soll stoppen
Weiter: ganz einfach vom Stoppunkt weiterlaufen
Reset: die Zeitvorgabe soll wieder mit 15 Min. (00:15:00) gefüllt werden.
NICE to have... gäbe es auch noch, wenn jemand Lust hat:
die letzten 15 Sekunden beim Countdown sollte sich die Schriftfarbe in ROT ändern, wenn das geht.
Vielen Dank schon mal
Erwin

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Countdown ergänzen
18.03.2013 21:04:48
Mister-B
Hallo Erwin,
nice to have: von blau auf rot
Private Sub TimerAdresse(ByVal hwnd As Long, _
ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
If frmTimer.lblZeit = "" Then
frmTimer.lblZeit = Format(CDate(frmTimer.TXT_Zeit) - CDate("00:00:01"), "hh:mm:ss")
'If CDate(frmTimer.lblZeit) > "00:00:15" Then frmTimer.lblZeit.ForeColor = & _
HFF& Else frmTimer.lblZeit.ForeColor = &HFF0000
ElseIf CDate(frmTimer.lblZeit) = "00:00:01" Then
Ende
frmTimer.lblZeit = "00:00:00"
MsgBox "Fertig"
frmTimer.lblZeit.Caption = ""
frmTimer.TXT_Zeit = ""
Else
frmTimer.lblZeit = CDate(CDate(frmTimer.lblZeit) - CDate("00:00:01"))
End If
If CDate(frmTimer.lblZeit)
Gruß
Martin

Anzeige
AW: Countdown ergänzen
18.03.2013 21:11:18
Mister-B
Hallo Ich nochmal,
Neues Modul mit:
Option Explicit
Private Declare Function Beep Lib "kernel32" (ByVal Fq As Long, ByVal Tm As Long) As Long 
Public Sub Beep()
Beep 500, 500
End Sub
Makro TimerAdresse mit diesem ersetzen:
Private Sub TimerAdresse(ByVal hwnd As Long, _
ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
If frmTimer.lblZeit = "" Then
frmTimer.lblZeit = Format(CDate(frmTimer.TXT_Zeit) - CDate("00:00:01"), "hh:mm:ss")
'If CDate(frmTimer.lblZeit) > "00:00:15" Then frmTimer.lblZeit.ForeColor = & _
HFF& Else frmTimer.lblZeit.ForeColor = &HFF0000
ElseIf CDate(frmTimer.lblZeit) = "00:00:01" Then
Ende
frmTimer.lblZeit = "00:00:00"
MsgBox "Fertig"
frmTimer.lblZeit.Caption = ""
frmTimer.TXT_Zeit = ""
Else
frmTimer.lblZeit = CDate(CDate(frmTimer.lblZeit) - CDate("00:00:01"))
End If
If CDate(frmTimer.lblZeit)
Gruß
Martin

Anzeige
AW: Countdown ergänzen
18.03.2013 21:22:45
Erwin
Hallo Martin,
danke schon mal für die Hilfe, werde ich sofort ausprobieren.
Ich setze mochmals auf "Beitrag offen", weil eigentlich die "MUST have..." noch nicht erledigt sind.
Wenn sich noch jemand versuchen möchte, die 3 Buttons "Stop", "Weiter" und "Reset" bräuchte ich bitte noch für den countdown.
Danke und Grüße
Erwin

AW: Countdown ergänzen
18.03.2013 21:46:31
Mister-B
Hallo Erwin,
leider steigere ich bei deinem Code nicht ganz so durch. Ich bin ja auch kein VBA Profi. Der Reset konntest du mit dem Code
Unload Me
frmTimer.Show
realisieren. Vielleicht nicht die elegantste Lösung, funktioniert aber.
Einen schönen Abend.
Gruß
Martin

Anzeige
AW: Mister-B @ Martin
18.03.2013 21:54:11
Erwin
Hallo,
ich habe das jetzt ausprobiert.
In deinem letzten Absatz ist irgendwie ein Fhler, sodass Excel komplett abstürzt. 

If CDate(frmTimer.lblZeit)

In der vorletzten Zeile (vor End Sub) erscheint die Fehlermeldung:
"Fehler bem Kompilieren: Sub oder Funktion nicht definiert"
Außerdem verstehe ich nicht, was es bedeuten soll: ... Then test
wohin wird da verwiesen?
Erwin

AW: Mister-B @ Martin
18.03.2013 22:32:56
Erwin
Hallo,
durch try and error habe ich einen Teil jetzt lösen können.
Ist der countdown fertig, erscheint die MsgBox mit der Meldung "Fertig". Drücke ich dann auf OK erscheint Laufzeitfehler 13 - Typen unverträglich.
Markiert ist: If CDate(frmTimer.lblZeit) 
End Ife
If CDate(frmTimer.lblZeit)
Da komme ich nicht weiter
Außerdem müssten die Buttons "Stop" und "Weiter" noch mit einem Code versehen werden...
Erwin

Anzeige
AW: Mister-B @ Martin
19.03.2013 09:38:50
Lutz
Hallo zusammen,
das Projekt ist ganz interessant - toll wäre es, wenn man zwischendurch auch wieder die Excel-Datei hochladen würde.
Dann wäre es auch leichter zu helfen - und ich finde es wäre immer gut am Ende die letzte Lösung Online zu stellen damit andere das später auch nutzen können.
Viele Grüße Lutz

Interessantes Projekt @ Lutz / Martin
19.03.2013 10:27:25
Erwin
Hallo Lutz,
hier ist die letzte Version: https://www.herber.de/bbs/user/84443.xlsm
Im Moment erscheint der Laufzeitfehler 13 - Typen unverträglich
Markiert ist: 

If CDate(frmTimer.lblZeit)
Auch das mit den beiden Buttons "Stop" und "Weiter" ist noch offen.
Vielleicht kann sich ja nochmal jemand versuchen
Erwin

Anzeige
AW: Interessantes Projekt @ Lutz / Martin
19.03.2013 11:34:58
Mister
Hallo Allerseits,
mit folgendem überarbeiteten Makro läuft das runterzählen ohne Fehlermeldung:
Private Sub TimerAdresse(ByVal hwnd As Long, _
ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
If frmTimer.lblZeit = "" Then
frmTimer.lblZeit = Format(CDate(frmTimer.TXT_Zeit) - CDate("00:00:01"), "hh:mm:ss")
ElseIf CDate(frmTimer.lblZeit) = "00:00:01" Then
Ende
frmTimer.lblZeit = "00:00:00"
MsgBox "Fertig"
frmTimer.lblZeit.Caption = ""
frmTimer.TXT_Zeit = ""
Exit Sub
Else
frmTimer.lblZeit = CDate(CDate(frmTimer.lblZeit) - CDate("00:00:01"))
End If
If CDate(frmTimer.lblZeit)

Gruß
Martin

Anzeige
zum Thema 'Timer' ....
19.03.2013 10:35:54
Rudi
Hallo,
findest du im Archiv 100e Beiträge
Gruß
Rudi

AW: zum Thema 'Timer' ....
19.03.2013 11:24:52
Erwin
Hallo Rudi,
bevor ich ein Projekt beginne suche ich natürlich erst bei Herber.de, dann bei weiteren bekannten Excelseiten.
Ich lade mir etliche Beispiele runter, schaue die an und prüfe, ob es meinen Anforderungen entspricht - und ob ich es evtl. selbst anpassen kann.
Mein Level für VBA ist mehr als Markorecorder - ich kann mir einiges zusammenreimen und dann kommt "try and error".
Manchmal wie hier kommt der "error" und dann bin ich auf die vielen Helfer hier angewiesen.
Vielleicht kann sich ja doch noch jemand bemühen und zumindest den Laufzeitfehler rausmachen.
Die neueste Datei ist im vorletzten thread.
Danke
Erwin

Anzeige
Danke - super
19.03.2013 12:07:21
Erwin
Hallo Martin,
recht vielen Dank für deine Mühe, die du dir nochmals gemacht hast.
Genau so habe ich mir einen Counter / Countdown / Timer vorgestellt.
Grüße
Erwin

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige