Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1872to1876
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
Inhaltsverzeichnis

Text sekündlich bei Loop anzeigen lassen

Text sekündlich bei Loop anzeigen lassen
11.03.2022 20:55:21
Nico1116
Hallo,
ich hätte folgendes Problem bei meiner Programmierung: Ich habe eine Loop erzeugt und diese stellt einen Timer da. Solange die Schleife läuft soll in einem Beschriftungsfeld die noch verbleibende Zeit angezeigt werden. Wenn ich z.B. eine Message Box einfügen lassen würde und bei dieser immer auf ok drücke würde es funktionieren.
Daher meine Frage wie kann ich es machen, dass es sich von selber wiederholt und auch ausführt ohne, dass ich etwas drücken muss.
Entschuldigung, dass ich den Code jetzt hier als Text eingefügt habe, aber als was müsste ich ihn speichern damit ich ihn am besten hier herzeigen kann?
Danke schonmal im voraus
Nico116

Private Sub btn_Start_Click()
Dim initialzeit As Variant
Dim eingestellte_zeit As Variant
Dim restzeit As Variant
initialzeit = Time
eingestellte_zeit = TimeSerial(Std, Min, Sec)
Do While eingestellte_zeit > (Time - initialzeit)
restzeit = eingestellte_zeit - (Time - initialzeit)
lbl_Zeit.Caption = restzeit
Loop
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Text sekündlich bei Loop anzeigen lassen
11.03.2022 23:46:07
volti
Hallo Nico,
hier eine Idee, wie Du mit einer MsgBox einen CountDown erzeugen kannst.
Code:


Option Explicit Private Declare PtrSafe Function FindWindowA Lib "user32" ( _ ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function KillTimer Lib "user32" ( _ ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long Private Declare PtrSafe Function SetTimer Lib "user32" ( _ ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _ ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr Private Declare PtrSafe Function MessageBoxA Lib "user32" ( _ ByVal hWnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, _ ByVal wType As Long) As Long Private Declare PtrSafe Function SetDlgItemTextA Lib "user32" ( _ ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long Private Declare PtrSafe Function GetDlgItemTextA Lib "user32" ( _ ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, _ ByVal lpString As String, ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function PostMessageA Lib "user32" ( _ ByVal hWnd As LongPtr, ByVal wMsg As Long, _ ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long Private Const WM_CLOSE = &H10 Private hTimer As LongPtr Private gsCaption As String Sub CountDownEx() 'Anzeigen einer MsgBox mit CountDown hTimer = SetTimer(0&, 0&, 1000, AddressOf SetMsgText) gsCaption = "CountDown" MessageBoxA Application.hWnd, "Ende in 5 Sekunden", gsCaption, vbExclamation Or vbModeless KillTimer 0&, hTimer End Sub Private Sub SetMsgText() Dim i As Integer, sArr() As String, hDlg As LongPtr Dim sText As String * 255 hDlg = FindWindowA("#32770", gsCaption) GetDlgItemTextA hDlg, 65535, sText, 255 sArr = Split(Left$(sText, InStr(sText, vbNullChar) - 1)) For i = 0 To UBound(sArr) If Val(sArr(i)) > 0 Then sArr(i) = sArr(i) - 1 DoEvents If sArr(i) < 1 Then PostMessageA hDlg, WM_CLOSE, 0&, 0& SetDlgItemTextA hDlg, 65535, ByVal Join$(sArr) End If Next i End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige
Du rauchst ja immer noch diese Zeugs...
12.03.2022 08:37:44
{Boris}
Hi Karl-Heinz,
...aber rauch ruhig weiter - ich bin ein dankbarer (stiller) Abnehmer :-)
Klasse!
VG, Boris
AW: Du rauchst ja immer noch diese Zeugs...
12.03.2022 12:11:15
volti
Hi Boris,
vielen Dank für die positive Rückmeldung.
Mit dem "Kapern" von Msgbox, Inputbox und Co. kann man so einiges außergewöhnliches lösen, z.B. beim Runterzählen auch einen Balken mitlaufen lassen.
Kannst ja mal hier vorbeischauen und Dir die Musterdatei anschauen.
https://www.clever-excel-forum.de/Thread-Inputbox-mit-vorgegebenen-Eingabezeichen-und-begrenzter-Eingabelaenge
Gruß
KH
Anzeige
Jesus Maria...
12.03.2022 12:21:44
{Boris}
Hi Karl-Heinz,
...komplett durchgeknallt - GENIAL! ;-)
Ist dauerhaft gespeichert :-)
VG, Boris
ich schließe mich Boris an
15.03.2022 09:36:28
lupo1
... schön, wenn man mal das API-Zeugs am Beispiel sieht!
AW: ich schließe mich Boris an
15.03.2022 10:54:24
volti
Danke Euch, 👍
Gruß KH

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige