Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Popup schließt nicht automatisch

Betrifft: Popup schließt nicht automatisch von: Susanne
Geschrieben am: 01.08.2008 12:23:49

Hallo,
hab hier einen Code(Ursprung weiß ich nicht mehr, sorry),
der eine Mail verschickt, sobald eine Zelle sich nicht mehr verändert UND ein Popup erscheint, was sich nach 10 Sekunden automatisch schließen soll. Problem ist: Es schließt sich nicht automatisch, was dazu führt, daß das ganze Makro angehalten wird, also auch die Mail nicht rausgeht.
Wo hängt der Code?
LG
Susanne

Public Sub AlarmHandler()

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' following commands are executed each interval
If Cell_1HasChanged Then
' just for debug
' EmailSubject = "no alarm"
' MailSenden
Else
EmailSubject = Format(Now, "hh:nn:ss") + " alarm alert; value (" & CheckCell_1 & ") = " & Range(CheckCell_1).Value

' sound and pop-up
' Call sndPlaySound32("C:\tmp\doorbell.wav", 1)
Call sndPlaySound32(AlarmSoundFile, 1)
Set WshShell = CreateObject("WScript.Shell")
intText = WshShell.Popup(EmailSubject, 19, "Alarm", vbSystemModal)

MailSenden


End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
iTimerSet = Now + TimeValue(CheckInterv) ' increment timer to next interval

  

Betrifft: AW: Popup schließt nicht automatisch von: Ramses
Geschrieben am: 01.08.2008 12:49:33

Hallo

Das PopUp bleibt, wie angegeben, für 19 Sekunden offen, also anpassen, und lass das ", vbSystemModal" mal weg

Gruss Rainer


  

Betrifft: AW: Popup schließt nicht automatisch von: Susanne
Geschrieben am: 01.08.2008 19:05:09

Hallo,
Danke für den Lösungsvorschlag.
Hab den gesamten Code jetzt mal gepostet mit deiner Änderung.
Es bleibt aber dabei: Das Popup bleibt auf und blockiert den Ablauf. Sobald man mit "ok" die Sache schließt, geht die Mail raus und der Ablauf geht weiter. Bis zum nächsten Popup.
Woran könnte das liegen?
LG



Public Sub AlarmHandler()

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' following commands are executed each interval
    If Cell_1HasChanged Then
        ' just for debug
        ' EmailSubject = "no alarm"
        ' MailSenden
      Else
        EmailSubject = Format(Now, "hh:nn:ss") + " alarm alert; value (" & CheckCell_1 & ") = "  _
& Range(CheckCell_1).Value
        
        ' sound and pop-up
'        Call sndPlaySound32("C:\tmp\doorbell.wav", 1)
        Call sndPlaySound32(AlarmSoundFile, 1)
        Set WshShell = CreateObject("WScript.Shell")
        intText = WshShell.Popup(EmailSubject, 19, "Alarm")
        
        MailSenden
        

    End If
        
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    iTimerSet = Now + TimeValue(CheckInterv)      ' increment timer to next interval
    If Format(Now, "hh:nn:ss") < TimeCheck Then
       Application.OnTime iTimerSet, "AlarmHandler" 'recall ; Selbstaufruf
    Else
       KillAlarmHandler
    End If
End Sub



Public Sub KillAlarmHandler()
    On Error Resume Next
    Application.OnTime iTimerSet, "AlarmHandler", , False
End Sub



Private Sub MailSenden()
Dim MyOutApp As Object, MyMessage As Object
    Set MyOutApp = CreateObject("Outlook.Application")
    Set MyMessage = MyOutApp.CreateItem(0)
    With MyMessage
        .to = TargetEmail ' "Hier kommt die Adresse rein"
        '"hier der Betreff"
        .Subject = EmailSubject
        
'''''''''''''''''''''''''''''''''''''''''''''''''''
'  email body
'''''''''''''''''''''''''''''''''''''''''''''''''''
        .body = "value of cell (" & CheckCell_1 & ") = " & Range(CheckCell_1).Value
'''''''''''''''''''''''''''''''''''''''''''''''''''
             '.Attachments.Add 'für Anlagen

        .Importance = 2 'Wichtigkeit hoch
        .Display
        .Send  'Hier wird die Mail gesendet
       
    End With

    Set MyOutApp = Nothing
    Set MyMessage = Nothing
End Sub




Private Function Cell_1HasChanged() As Boolean
  Static vLastStored As Variant
  If Range(CheckCell_1).Value = vLastStored Then
        Cell_1HasChanged = False
    Else
        Cell_1HasChanged = True
  End If
  vLastStored = Range(CheckCell_1).Value
End Function




  

Betrifft: AW: Popup schließt nicht automatisch von: Ramses
Geschrieben am: 01.08.2008 23:06:36

Hallo

Ich denke da ist die Systemperformance auch noch verantwortlich.
Der Code als solches funktioniert, und auch das PopUp verschwindet.
Allerdings dauert es bei mir bei eingestellten 20 Sekunden bis zu 35 Sekunden bis das PopUp verschwindet.

Gruss Rainer


  

Betrifft: AW: Popup schließt nicht automatisch von: Nepumuk
Geschrieben am: 02.08.2008 00:04:40

Hallo Susanne und Rainer

auf irgendeinem Rechner hatte ich das auch shon mal. Das Popup hat sich nicht selbst geschlossen. Warum, habe ich aber nie herausbekommen und ich weiß auch nicht mehr welcher Rechner mit welcher Software das war. Darum hab ich mir eine Prozedur geschrieben, welche eine "normale" MsgBox nach vorgegebener Zeit automatisch schließt. Hier mal ein Beispielcode:

' **********************************************************************
' Modul: Modul4 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal nIDEvent As Long) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByRef lParam As Any) As Long

Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"
Private Const GC_CLASSNAMEMSDIALOGS = "#32770"

Private Const WM_CLOSE = &H10

Private lstrBoxTitle As String
Private llngXLhWnd As Long

Public Sub prcMsgBox_Time3()
    lstrBoxTitle = "Information"
    llngXLhWnd = FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption)
    Call SetTimer(llngXLhWnd, 0&, 2000&, AddressOf prcTimer) '2000 Millisekunden
    MsgBox "Diese Meldung schließt sich selbst.", vbInformation, lstrBoxTitle
End Sub

Private Sub prcKillBox()
    Dim lngBox_hWnd As Long
    lngBox_hWnd = FindWindow(GC_CLASSNAMEMSDIALOGS, lstrBoxTitle)
    If lngBox_hWnd <> 0 Then _
        Call PostMessage(lngBox_hWnd, WM_CLOSE, 0&, 0&)
End Sub

Private Sub prcTimer(ByVal hWnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As Long)

    Call prcKillTimer
    Call prcKillBox
End Sub

Private Sub prcKillTimer()
    Call KillTimer(llngXLhWnd, 0&)
End Sub

Gruß
Nepumuk


  

Betrifft: AW: Popup schließt nicht automatisch von: Susanne
Geschrieben am: 04.08.2008 13:37:33

Hallo, ihr Beiden.
An der Systemperformance liegt es definitiv nicht. Es schließt sich einfach nicht selbstständig.
Die Lösung von Nepumuk erscheint mir denn doch etwas kompliziert, zumal das Popup ein Schmankerl ist, aber ist entscheidend.
Versuche daher gerade, daß Popup ganz herauszunehmen.
Frage mich allerdings gerade, was muß ich da löschen? Könnt ihr mit letztmalig helfen?
Die Herausnahme von
Set WshShell = CreateObject("WScript.Shell")
intText = WshShell.Popup(EmailSubject, 19, "Alarm")
reicht scheinbar nicht.
LG
Susanne


Public Sub AlarmHandler()
  
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      ' following commands are executed each interval
      If Cell_1HasChanged Then
          ' just for debug
          ' EmailSubject = "no alarm"
          ' MailSenden
        Else
          EmailSubject = Format(Now, "hh:nn:ss") + " alarm alert; value (" & CheckCell_1 & ") =  _
"  _
  & Range(CheckCell_1).Value
          
          ' sound and pop-up
  '        Call sndPlaySound32("C:\tmp\doorbell.wav", 1)
          Call sndPlaySound32(AlarmSoundFile, 1)
          Set WshShell = CreateObject("WScript.Shell")
          intText = WshShell.Popup(EmailSubject, 19, "Alarm")
          
          MailSenden
          
  
      End If
          
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      iTimerSet = Now + TimeValue(CheckInterv)      ' increment timer to next interval
      If Format(Now, "hh:nn:ss") < TimeCheck Then
         Application.OnTime iTimerSet, "AlarmHandler" 'recall ; Selbstaufruf
      Else
         KillAlarmHandler
      End If
  End Sub






Public Sub KillAlarmHandler()
      On Error Resume Next
      Application.OnTime iTimerSet, "AlarmHandler", , False
  End Sub






Private Sub MailSenden()
  Dim MyOutApp As Object, MyMessage As Object
      Set MyOutApp = CreateObject("Outlook.Application")
      Set MyMessage = MyOutApp.CreateItem(0)
      With MyMessage
          .to = TargetEmail ' "Hier kommt die Adresse rein"
          '"hier der Betreff"
          .Subject = EmailSubject
          
  '''''''''''''''''''''''''''''''''''''''''''''''''''
  '  email body
  '''''''''''''''''''''''''''''''''''''''''''''''''''
          .body = "value of cell (" & CheckCell_1 & ") = " & Range(CheckCell_1).Value
  '''''''''''''''''''''''''''''''''''''''''''''''''''
               '.Attachments.Add 'für Anlagen
  
          .Importance = 2 'Wichtigkeit hoch
          .Display
          .Send  'Hier wird die Mail gesendet
         
      End With
  
      Set MyOutApp = Nothing
      Set MyMessage = Nothing
  End Sub







Private Function Cell_1HasChanged() As Boolean
    Static vLastStored As Variant
    If Range(CheckCell_1).Value = vLastStored Then
          Cell_1HasChanged = False
      Else
          Cell_1HasChanged = True
    End If
    vLastStored = Range(CheckCell_1).Value
  End Function




  

Betrifft: AW: Popup schließt nicht automatisch von: Nepumuk
Geschrieben am: 06.08.2008 16:35:48

Hallo Susanne,

eigntlich solte das reichen. Was passiert denn bzw. was nicht? (Um das ganze nachzubauen fehlt mir gerade die Lust).

Gruß
Nepumuk


 

Beiträge aus den Excel-Beispielen zum Thema "Popup schließt nicht automatisch"