Hallo zusammen...
Könnte ihr bitte über den Code mal rüberschauen, ob euch Fehler auffallen oder Verbesserungen. Ist nicht mein Code, aber der hat ja schon einige Jahre auf dem Buckel und vielleicht würde man/ihr das heute anders schreiben?
Vielleicht kurz, was erreicht werden soll. Auf meine UserForm werden mehrere Benutzer Zugriff haben. Nicht gleichzeitig, also ist es notwendig die UserForm nach Inaktivität (z.B. 5 Minuten) zuschließen und vorab eine kurze Warnmeldung einzublenden. Entweder wird auf die Warnmeldung reagiert, also der Timer zum Schließen auf einen Button zurückgesetzt oder falls man nicht reagiert, schließt die UserForm. Die UserForm mit der Warnmeldung ist bei mir die UserForm999 und hat zwei Button. Einen mit "Nein", also nicht schließen und einen mit "Datei schließen."
Der Code für "DieseArbeitsmappe"
Code:
Option Explicit
' erstellt von Hajo.Ziplies@web.de 28.12.03
' http://home.media-n.de/ziplies/
Private Sub Workbook_Open()
Zeitmakro
UserForm1.Show
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime EarliestTime:=ET, Procedure:="Start", Schedule:=False
Application.OnTime EarliestTime:=ET1, Procedure:="Schließen", Schedule:=False
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.OnTime EarliestTime:=ET, Procedure:="Start", Schedule:=False
Zeitmakro
End Sub
Der Code für "Modul"
Code:
Option Explicit
' erstellt von Hajo.Ziplies@web.de 28.12.03 abgeändert von Nepumuk 23.05.2004
' http://home.media-n.de/ziplies/
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Public Enum Parameter
HWND_TOPMOST = -1
SWP_NOSIZE = &H1
SWP_NOMOVE = &H2
SWP_NOACTIVATE = &H10
SWP_SHOWWINDOW = &H40
End Enum
Public ET As Variant
Public ET1 As Variant
Public BoZu As Boolean
Declare Function Ton& Lib "kernel32" _
Alias "Beep" _
(ByVal dwFrequenz As Long, _
ByVal dwDauer As Long)
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Zeitmakro()
BoZu = False
On Error Resume Next
Application.OnTime EarliestTime:=ET1, Procedure:="Zeitmakro", Schedule:=False
ET = Now + TimeValue("00:00:15")
Application.OnTime ET, "Start"
End Sub
Sub Start()
ET1 = Now + TimeValue("00:00:10")
Application.OnTime ET1, "Schließen"
SetActiveWindow FindWindow("xlMain", vbNullString)
UserForm999.Show
End Sub
Sub Schließen()
Unload UserForm999
If BoZu = False Then
'ThisWorkbook.Save 'vor schliessen wird gespeichert
If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End If
End Sub
Der Code für "UserForm"
Code:
Option Explicit
' erstellt von Hajo.Ziplies@web.de 28.12.03
' http://home.media-n.de/ziplies/
Dim Uhrzeit
'ANFANG UserForm ohne Schliessen_Kreuz
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long
'ENDE UserForm ohne Schliessen_Kreuz
Private Sub UserForm_Activate()
'ANFANG UserForm ohne Schliessen_Kreuz
Dim xl_hwnd, lStyle
xl_hwnd = FindWindow(vbNullString, Me.Caption)
If xl_hwnd <> 0 Then
lStyle = GetWindowLong(xl_hwnd, GWL_STYLE)
lStyle = SetWindowLong(xl_hwnd, GWL_STYLE, lStyle And Not WS_SYSMENU)
DrawMenuBar xl_hwnd
End If
'ENDE UserForm ohne Schliessen_Kreuz
Dim I, GeöffneteFormulare
BoZu = False
SetWindowPos FindWindow(vbNullString, Me.Caption), HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
Uhrzeit = Now + TimeValue("0:00:01")
Do
For I = 1 To 100 ' Schleifenanfang.
If I Mod 100 = 0 Then ' Nach 100 Durchläufen Steuerung
GeöffneteFormulare = DoEvents ' an das Betriebssystem abgeben.
End If
Next I ' Schleifenzähler hochzählen.
Loop Until Now > Uhrzeit + TimeValue("0:00:05")
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' Damit mit X nicht geschloßen werden kann
If CloseMode = 0 Then
MsgBox "Bitte schließen Sie die Anwendung mit der -Ende- Schaltfläche.", vbCritical
Cancel = 1
End If
End Sub
Private Sub CMD_Nein_Click()
Uhrzeit = Uhrzeit - TimeValue("0:00:05")
Application.OnTime EarliestTime:=ET1, Procedure:="Schließen", Schedule:=False
BoZu = True
Zeitmakro
Me.Hide
End Sub
Private Sub Cmd_Schliessen_Click()
' nach Hinweis von Nepumuk ergänzt
Schließen
End Sub
Was mir zum Beispiel schon aufgefallen ist, dass bisweilen, konnte es noch nicht nachstellen, von Excel noch die Nachfrage kommt, ob die Datei gespeichert werden soll oder nicht. Die Meldung sollte irgendwie nicht kommen, sonst läuft das mit dem automatischen schließen ja ins Leere, wenn der Nutzer nicht vor dem Rechner sitzt.
Danke schon jetzt und Grüße