Office: (Office 2016) Datei Schließen (Bei Schreibschutz ohne speichern, ohne Schreibschutz speichern) VBA

Hallo zusammen,
ich möchte per VBA beim beenden bzw. schließen der Datei abfragen ob diese Schreibgeschützt geöffnet ist.

1. Ist Datei Schreibgeschützt dann schließen, nicht speichern, nicht nachfragen nach speichern
2. Datei ist nicht Schreibgeschützt geöffnet, speichern, nicht nachfragen nach speichern

Ich habe folgende Codes in einem Modul bzw. in der Arbeitsmappe:

Modul:

HTML:

Option Explicit                                     ' Variablendefinition erforderlich
Dim DaEt As Date                                    ' Zeitpunkt zum prüfen
Public Const DaZeit As Date = "00:05:00"            ' Zeitabstand prüfen

Sub startzeit()
    On Error Resume Next                            ' Fehlerbehandlung ausschalten
    ' Makro anhalten
    Application.OnTime EarliestTime:=DaEt, Procedure:="Schließen", Schedule:=False
    On Error GoTo 0                                 ' Fehlerbehandlung einschalten
    DaEt = Now + DaZeit                             ' neue Startzeit setzen
    Application.OnTime DaEt, "Schließen"            ' Makro zum Zeitpunkt starten
End Sub

Sub Schließen()
Windows("Tier3 2020.xlsm").Activate

Dim wsTab As Worksheet
    Dim i As Integer
    For i = 1 To 13
    Dim rngWerte As Range
    Dim rngFormeln As Range
    On Error Resume Next
    On Error GoTo 0
  
      Next i
      
        ThisWorkbook.Save
        
            
   ThisWorkbook.Save
    
    On Error Resume Next                            ' Fehlerbehandlung ausschalten
   
  Ende
    ThisWorkbook.Close True                        ' Datei schließen mit speichern, False ohne speichern
End Sub

Sub Ende()
    ' Makro anhalten
    Application.OnTime EarliestTime:=DaEt, Procedure:="Schließen", Schedule:=False
    
  

End Sub

Arbeitsmappe:

HTML:

                                    ' Variablendefinition erforderlich
                                     ' Variablendefinition erforderlich
Private Sub Workbook_Open()

    startzeit                                       ' Prozedur starten
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    startzeit                                       ' Prozedur starten
End Sub

Private Sub ThisWorkbook_BeforeClose(Cancel As Boolean)
'Windows("Tier3 2020.xlsm").Activate

'Dim wsTab As Worksheet
    'Dim i As Integer
    'For i = 1 To 13
    'Dim rngWerte As Range
    'Dim rngFormeln As Range
    On Error Resume Next
    On Error GoTo 0
  
      Next i
            ThisWorkbook.Save
   
    
    On Error Resume Next                            ' Fehlerbehandlung ausschalten
   
  Ende
    ThisWorkbook.Close False                         ' Datei schließen mit speichern, False ohne speichern
End Sub

Ich hoffe ich konnte mich einigermaßen ausdrücken ;-).

Danke für die Unterstützung
Grüße MHS1002

 

Hallo,

die Anweisungsabfolge müsste IMHO lauten:

Code:

'.....
   On Error Resume Next
   ActiveWorkbook.Save
   On Error GoTo 0
'.....

Anmerkungen:

• Mit "On Error GoTo Sprungmarke1" wird eine Fehlerbehandlung eingeschaltet, sodass das Programm auf einen möglicherweise auftretenden Fehler ohne Programmabbruch reagieren kann. Tritt nach dieser Programmzeile tatsächlich ein Fehler auf, springt das Programm zur Programmzeile, die mit der Marke "Sprungmarke1:" gekennzeichnet ist, und fährt dort fort, bis es zur Anweisung "Resume Sprungmarke2" gelangt. Daraufhin verlässt das Programm den Programmbereich, der für die Fehlerbehandlung zuständig ist, löscht das vorhin erzeugte "Err"-Objekt und springt zu der Programmzeile mit der Marke "Sprungmarke2:".
• Mit "On Error GoTo 0" kann man die Fehlerbehandlung explizit ausschalten. Tritt nach dieser Programmzeile ein Fehler auf, bricht das Programm mit Fehlermeldung ab.
• Mit "On Error Resume Next" kann man erreichen, dass zwar eine Fehlerbehandlung eingeschaltet wird, aber das Programm verzweigt nirgendwohin, sondern fährt in der nächsten Programmzeile fort. Die Fehlerbehandlung ist quasi "stumm" geschaltet. Man könnte aber nichtsdestotrotz in diesem Fall vom erzeugten "Err"-Objekt die "Err.Number" bzw. "Err.Description" erfragen, etc. bzw. mit "Err.Clear" den erzeugten Fehler wieder löschen.
• Statt "ActiveWorkbook.Save" kann man auch "ThisWorkbook.Save" einsetzen - man muss sich nur über den Unterschied im Klaren sein: Ob man die aktive Arbeitsmappe speichern will oder aber die Arbeitsmappe, in der dieses Makro enthalten ist (Das ist nur dann wichtig, wenn man mehrere Arbeitsmappen gleichzeitig geöffnet hat).

 

Hi und danke für die Antwort. Da steig ich leider nicht richtig durch ;-)
Ich denke ich habe das Problem wie folgt lösen können, falls noch was falsch ist gerne verbessern. Vielen Dank!

HTML:

Option Explicit                                     ' Variablendefinition erforderlich
Dim DaEt As Date                                    ' Zeitpunkt zum prüfen
Public Const DaZeit As Date = "00:05:00"            ' Zeitabstand prüfen

Sub startzeit()
    On Error Resume Next                            ' Fehlerbehandlung ausschalten
    ' Makro anhalten
    Application.OnTime EarliestTime:=DaEt, Procedure:="Schließen", Schedule:=False
    On Error GoTo 0                                 ' Fehlerbehandlung einschalten
    DaEt = Now + DaZeit                             ' neue Startzeit setzen
    Application.OnTime DaEt, "Schließen"            ' Makro zum Zeitpunkt starten
End Sub

Sub Schließen()
Windows("Tier3 2020.xlsm").Activate

Dim wsTab As Worksheet
    Dim i As Integer
    For i = 1 To 13
    Dim rngWerte As Range
    Dim rngFormeln As Range
    On Error Resume Next
    On Error GoTo 0
  
     Next i
    'ThisWorkbook.Save
   
    
    On Error Resume Next                            ' Fehlerbehandlung ausschalten
   
  Ende
    'ThisWorkbook.Close True                         ' Datei schließen mit speichern, False ohne speichern
    
    
     If ThisWorkbook.ReadOnly Then ThisWorkbook.Saved = True
 'If ThisWorkbook.ReadOnly Then MsgBox "Datei war schreibgeschützt. Änderungen wurden nicht gespeichert!", , "Datei war schreibgeschützt."
 If ThisWorkbook.ReadOnly = False Then ThisWorkbook.Close savechanges:=True
End Sub

Sub Ende()
    ' Makro anhalten
    Application.OnTime EarliestTime:=DaEt, Procedure:="Schließen", Schedule:=False
End Sub