Msgbox schließen nach 3 Sek

[Beltason]

Hallo Leute,

ich habe eine Datei in der Msgboxen ausgelöst werden.

Private Sub Worksheet_Activate()

Dim lngCalc As Long
        With Application
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False

      

     
        If .Range("H38") * 24 > 35 And .Range("H38") * 24 < 47 Then MsgBox "Es sind noch " & Format(47 - .Range("H38") * 24, "0.0") & " Einsatzstunden möglich"
        If .Max(Range("H38") * 24) = 47 Then MsgBox "ACHTUNG!" & Chr(13) & _
            "weitere Stunden im nächsten Monat eintragen"
            '"Vorgesehene Stundenanzahl überschritten!" & Chr(13) & _
            '"Std im nächsten Monat eintragen !"

        If .Max(Range("H38") * 24) > 47 Then MsgBox "ACHTUNG!" & Chr(13) & _
            "Vorgesehene Stundenanzahl um " & Format(.Range("H38") * 24 - 47, "0.0") & " Std. überschritten!" & Chr(13) & _
            "Std im nächsten Monat eintragen !"

        If .Range("H38") * 24 < 47 And .Range("H38") * 24 >= 40 Then MsgBox "Deine maximalen Std sind fast voll !"
        .EnableEvents = True
        .Calculation = lngCalc
    End With
End Sub



Meine Frage lautet nun, wo und wie muß der Code geändert werden, das sich die Msgboxen selbstständig nach 3 Sekunden schließen? Habe in google viele Ansätze und Lösungen gefunden, aber es wird nicht erklärt wie ich in schon "vorhanden Msgboxsen" Code einfüge.

Bin für jede Hilfe Dankbar

[volti]

Hallo,

hier zwei Beispiele....

Die Declares müssen ganz oben als erstes ins Modul. Den MSGBOX-Befehl kannst Du einbauen, wo Du willst.

Code:

Private Declare PtrSafe Function MessageBoxTimeoutA Lib "user32.dll" ( _
    ByVal hWnd As LongPtr, _
    ByVal lpText As String, _
    ByVal lpCation As String, _
    ByVal uType As Long, _
    ByVal wLanguageId As Integer, _
    ByVal dwMiliseconds As Long) As Long

Sub test1()
  If .Range("H38") * 24 > 35 And .Range("H38") * 24 < 47 Then
    MessageBoxTimeoutA Application.hWnd, _
        "Es sind noch " & Format(47 - .Range("H38") * 24, "0.0") & " Einsatzstunden möglich", _
        "TimeOut", vbInformation, 0, 3000    '3000 = 3 Sekunden
  End If
End Sub

Sub Test2()
  If .Range("H38") * 24 > 35 And .Range("H38") * 24 < 47 Then
    CreateObject("WScript.Shell").Popup "Es sind noch " & Format(47 - .Range("H38") * 24, "0.0") _
      & " Einsatzstunden möglich", 3, "TimeOut", vbOKOnly Or vbInformation
  End If
End Sub

_________
viele Grüße
Karl-Heinz