2 Dialoge behindern sich?
10.05.2017 16:51:34
Björn
ich habe folgenden Code durch den die Datei - nach einer gewissen Zeit der Untätigkeit - geschlossen wird. Klappt soweit auch ganz gut.
Nur wenn ich eine zweite Datei mit dem selben Code auch geöffnet habe, gelingt dies nicht mehr. Irgendwie scheinen sich die Dialoge zu behindern... Die Infobox erscheint, aber nach Ablauf der Zeit (30s) geschieht nichts mehr...
Ich habe auch schon versucht den subs eindeutige Namen zu geben, je nachdem in welcher Datei sie liegen (damit nicht aus dem einen Dokument das sub der anderen Datei aufgerufen werden)
Wer kann helfen?
Gruss und Danke
Björn
Code in "Diese Arbeitsmappe"
Private Sub Workbook_Open()
MsgBox "Damit die Datei nicht aus versehen geblockt wird, schließt sie sich automatisch nach _
einer INAKTIVITÄT von 10 Minuten!" & vbNewLine & vbNewLine & "Gemachte Änderungen werden vorher _
gespeichert!"
Call SetTimer
Worksheets("Start").Select
Range("ProdMittel").Value = "Produktionsmittel"
Range("ProdName").Value = "Produktion"
Range("ProdOrt").Value = "Produktionsort"
Range("UserName").Select
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopTimer
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call StopTimer
Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Excel.Range)
Call StopTimer
Call SetTimer
End Sub
Dann im Modul:
Dim DownTime As Date
Sub SetTimer()
DownTime = Now + TimeValue("00:10:00")
Application.OnTime EarliestTime:=DownTime, Procedure:="MsgClose", Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, Procedure:="MsgClose", Schedule:=False
End Sub
Sub MsgClose()
Dim AckTime As Integer, InfoBox As Object
Dim WkbName As String
WkbName = ThisWorkbook.Name
Set InfoBox = CreateObject("WScript.Shell")
AckTime = 30
Select Case InfoBox.Popup("Die Datei " & WkbName & " schließt sich automatisch in 30 _
Sekunden!" & vbNewLine & vbNewLine & "Gemachte Änderungen werden vorher gespeichert" & _
vbNewLine & vbNewLine & "Wenn Du mehr Zeit brauchst, klicke auf OK", _
AckTime, "Automatisches Schließen!!!", 0)
Case 1
Call StopTimer
Call SetTimer
MsgBox "Zeit verlängert"
Case -1
Application.DisplayAlerts = False
With ThisWorkbook
.Save
.Close
End With
Exit Sub
End Select
End Sub