UserForm nach inaktivität schließen

[sandormiles]

Folgende Aufgabenstellung: Ich habe ein VBA-Projekt mit mehreren Tabellenblättern und mehreren UserForm(en). Es wird mehrere Nutzer geben, die sollen allerdings nicht gleichzeitigen Zugriff haben. Damit also die Datei zur Bearbeitung nicht dauerhaft durch einen Nutzer blockiert wird, soll die gesamte Datei nach einer bestimmten Zeit geschlossen werden, wenn keine Aktivitäten in der Datei feststellbar ist. Bevor die Datei schließt soll noch eine Warnmeldung eingeblendet werden und der Nutzer per Button die Möglichkeit haben die Datei zu schließen oder zu bestätigen, dass weiter gearbeitet wird. Entweder der Nutzer reagiert, stimmt also dem Schließen zu oder lehnt ab oder es passiert weiter nichts, dann schließt das ganze Projekt. Ein Warnton ist nicht erforderlich.

Gefunden habe ich im Netz bereits folgenden Code:

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

"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

"UserForm" -> für Warnmeldung und mit Button zum Schließer oder Fortfahren

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

Der Code ist schon etwas älter (2003) und vielleicht gibt es hier schon "besseren" Code? Ich habe bisweilen das Problem, dass in meinem Projekt dennoch beim Schließen das ganze Projekt stehen bleibt mit der Frage, ob die Excel-Datei gespeichert werden soll.

Danke und Grüße

[Kuwer]

Hallo,

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

Gruß Uwe

[sandormiles]

Danke Uwe, funktioniert!