Thema Datum  Von Nutzer Rating
Antwort
Rot AutoClose
 08.12.2015 13:27:15 Bettina
Solved
09.12.2015 13:01:00 Gast17384
NotSolved
10.12.2015 09:22:04 Bettina
NotSolved

Ansicht des Beitrags:
Von:
Bettina		 Datum:
08.12.2015 13:27:15		 Views:
1943		 Rating:
     
Antwort:
 Nein
Thema:
AutoClose

Hallo Zusammen,

Ich habe ein Problem mit dem automatischen Schließen einer Excel Liste.
Bis jetzt hat alles ganz gut geklappt, wir hatten nur das Problem, dass sich die Liste nach dem Schließen jeweils zum beenden des Makros wieder geöffnet hat. Ließ sich ganz einfach beheben. Ich habe jetzt einen Code, der in einem ansonsten leeren Excel Sheet einwandfrei funktioniert, wenn ich ihn in mein gewünschtes Dokument integriere erhalte ich aber an einer anderen Stelle (die eigentlich seit Monaten einwandfrei funktioniert) den Laufzeitfehler 1004. Ich habe mich auch schon in das Thema OnTime eingelesen, leider aber ohne Erfolg.

Hat jemand eine Idee, woran das liegen könnte oder wie man das Problem anders lösen kann?

 

Mein Code:

In diese Arbeitsmappe:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Private Sub Workbook_Open()
     
     
    Sheets("Projektliste").Activate
    ActiveSheet.Range("A1").Activate
     
    dteCloseTime = Now + TimeSerial(0, 0, 30)
    Application.OnTime dteCloseTime, "DoClose"
     
    Dim freiezeile As Long
    freiezeile = Cells(Rows.Count, 1).End(xlUp).Row + 1
 
Set Rng = ActiveSheet.Range(Cells(freiezeile, 1), Cells(10000, 4))
Set rng1 = ActiveSheet.Range(Cells(1, 1), Cells(6, 42))
ActiveSheet.Unprotect Password:="schutzprojektliste123"
ActiveSheet.Cells.Locked = False
Rng.Locked = True
rng1.Locked = True
ActiveSheet.Protect Password:="schutzprojektliste123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowInsertingRows:=True
 
ActiveSheet.Range("A1").Activate
     
 
 
 
End Sub
 
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets("Projektliste").Activate
ActiveSheet.Unprotect Password:="schutzprojektliste123"
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
ActiveWindow.Zoom = 85
ActiveSheet.Range("B4") = Now() 'DIESE ZEILE VERURSACHT DEN LAUFZEITFEHLER
ActiveSheet.Protect Password:="schutzprojektliste123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowInsertingRows:=True
 
 
     
End Sub
 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
ThisWorkbook.SaveCopyAs "U:\1055_RT_Montage_MMZ\120_MTA\035_Projektliste_Projekte\Neue Projektliste\Backup Projektliste\" & "Backup Projektliste" & "_" & Format(Date, "dd_mm_yyyy") & ".xlsm"
 
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
End Sub
 
 
End Sub
 
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 0, 30)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub
 
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 0, 30)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 0, 30)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub
 
'Und im Modul:
 
Option Explicit
Option Private Module
Public dteCloseTime As Date, blnCloseNow As Boolean
 
Public Sub DoClose()
If ThisWorkbook.ReadOnly = False Then
Dim strMsg As String
If blnCloseNow = False Then
  strMsg = "Diese Datei wurde seit 9 Minuten nicht bearbeitet und" & vbCrLf & _
    "wird bei weiterer Inaktivität in 1 Minute geschlossen."
  CreateObject("WScript.Shell").PopUp strMsg, 10, ThisWorkbook.Name, _
    vbOKOnly + vbInformation + vbSystemModal
  blnCloseNow = True
  dteCloseTime = Now + TimeSerial(0, 0, 30)
  Application.OnTime dteCloseTime, "DoClose"
Else
  If Workbooks.Count = 1 Then
    If ThisWorkbook.Saved = False Then
      ThisWorkbook.Save
    End If
    Application.Quit
  Else
    ThisWorkbook.Close True
  End If
End If
Else
End If
End Sub

Vielen Dank im Voraus!

 

Grüße Bettina

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot AutoClose
 08.12.2015 13:27:15 Bettina
Solved
09.12.2015 13:01:00 Gast17384
NotSolved
10.12.2015 09:22:04 Bettina
NotSolved