Datei - Schreibschutz aufheben und wieder setzen

Hallo Excelprofis,
Über eine Schaltfläche werden alle Zeilen eines Bereiches eingeblendet und alle in Spalte A leeren Zeilen wieder ausgeblendet. Dies hat den Hintergrund, dass die Tabelle Verknüpfungen zu anderen Mappen enthält. Wenn in den Ursprungsmappen Zeilen gelöscht oder hinzugeügt werden, kann man sich schnell einen Überblick verschaffen.
Zum Schluß wird die Datei noch gespeichert.
Das funktioniert auch super.
Aus Gründen, auf die ich hier nicht weiter eingehen will, macht es sich erforderlich die Datei schreibgeschützt zu machen (also unter Datei-Eigenschaften - Schreibgeschützt).
Geht es, dass der Schreibschutz vor ausführen dieses Makros entfernt und nach dem speichern wieder gesetzt wird? So wie ich es probiert habe gehts wohl nicht (siehe auskommentierte Zeilen).
Option Private Module

Sub EinAusblendenLangsam()
Dim zelle As Range
Dim bereich As Range
Set bereich = ActiveSheet.Range("A8:A397")
ActiveSheet.Unprotect Password:="Passwort"
Application.ScreenUpdating = False
Application.EnableEvents = False
'ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, notify:=True
bereich.EntireRow.Hidden = True
For Each zelle In bereich
If zelle  "" Then
'Call FilternBereich
zelle.EntireRow.Hidden = False
End If
Next
ActiveSheet.Protect Password:="Passwort"
ActiveWorkbook.Save
'ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly, notify:=True
Application.ScreenUpdating = True
Application.EnableEvents = True
Range("A6").Select
End Sub

Danke fürs lesen und die Hilfe!
mfg, Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_Open() If IsDate(Worksheets("Übersicht").Range("J1")) Then If Month(Worksheets("Übersicht").Range("J1")) Month(Date) And Worksheets("Übersicht") _ _ .Range("J1") "" Then Meldung End If Else Meldung End If On Error Resume Next ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly, notify:=True On Error GoTo 0 End Sub

Hi
das Aufheben des Schreibschutzes mit:
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, notify:=True
bewirkt, dass die Datei neu gelesen wird (könnte ja sein, dass zwischenzeitlich jemand anderes die Datei ohne Schreibschutz geöffnet und verändert hat).
Damit stoppt nach dieser Befehlszeile jegliche Makroaktivität!
der Workaround ist folgendes Vorgehen:
1. Schreibe 2 Makros.
Das erste endet mit dem Aufheben des Schreibschutzes und enthält alle Befehle, die davor ausgeführt werden müssen
Das zweite enthält alle Makors, die danach ausgeführt werden sollen
2. Starte das Makro2 aus dem ersten heraus mit dem Befehl: Application.Ontime
den Merker für das Ausführen eines über Application.Ontime gestarteten Makros setzt sich Excel in der Excelapplication selbst und nicht in der Datei und ist daher in der Lage, das Makro auszuführen wenn die Datei zwischenzeitlich geschlossen wurde (sie wird dann wieder geöffnet):

Sub Makro1()
Application.Ontime Now, Makro2
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, notify:=True
End Sub
Sub Makro2()
hier dann der weitere Code
End Sub

Gruß Daniel

Sub EinAusblendenLangsam() Dim zelle As Range Dim bereich As Range Set bereich = ActiveSheet.Range("A8:A397") ActiveSheet.Unprotect Password:="" 'Bildschirmflackern ausschalten, Trigger ausschalten Application.ScreenUpdating = False Application.EnableEvents = False 'ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, notify:=True 'alle Zeilen einblenden bereich.EntireRow.Hidden = True 'jede Zeile prüfen For Each zelle In bereich 'wenn Zelleninhalt null, dann diese Zeile ausblenden If zelle "" Then 'Call FilternBereich zelle.EntireRow.Hidden = False End If Next ActiveSheet.Protect Password:="" ActiveWorkbook.Save ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly, notify:=True Application.ScreenUpdating = True Application.EnableEvents = True Range("A6").Select End Sub

Sub Schreib_Lesestatus_Ändern() On Error Resume Next Application.OnTime Now + TimeSerial(0,0,1), "EinAusblendenLangsam" ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, notify:=True On Error GoTo 0 End Sub

Beliebteste Forumthreads (12 Monate)

Datei - Schreibschutz aufheben und wieder setzen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

26 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Datei - Schreibschutz aufheben und wieder setzen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

26 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread