Text sekündlich bei Loop anzeigen lassen

Forumthread: 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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

Beliebteste Forumthreads (12 Monate)

Text sekündlich bei Loop anzeigen lassen

Forumthread: Text sekündlich bei Loop anzeigen lassen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Text sekündlich bei Loop anzeigen lassen

Forumthread: Text sekündlich bei Loop anzeigen lassen

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread