Popup schließt nicht automatisch

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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")

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

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

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")


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

Beliebteste Forumthreads (12 Monate)

Popup schließt nicht automatisch

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread