Abarbeitung des Codes nach ChangeFileAccess xlReadWrite

05.09.2025 11:14:56

Holger

Hallo,

ich habe folgendes Problem.
Wenn ich meine Arbeitsmappe vom Schreibschutz-Modus (xlReadOnly) in den Schreibmodus wechsle mit
ThisWorkbook.Saved = True
ThisWorkbook.ChangeFileAccess Mode:=xlReadWrite, WritePassword:="xxxxx"
... dann wird das Dokument neu geladen und der folgende Code nicht mehr abgearbeitet.

Hintergrund: Ich habe eine Datei, welche Standardmäßig nach dem Öffnen und den readonly-Modus wechselt. Die Datei ist nicht generell von vornherein mit Schreibpasswort versehen, da ansonsten beim Öffnen stets die Abfrage nach dem Passwort kommt und das ziemlich nervt. (Ich gehe auch nicht davon aus, dass das mein Problem beheben würde.)
Dann gibt es noch ein IMPORT button, wo externe Daten ausgelesen werden und diese Datei damit aktualisiert wird. Dafür muss dann zwischenzeitlich in den Schreibmodus gewechselt werden, gespeichert und wieder zu readonly. Nur wie erwähnt, nach dem drücken auf IMPORT wechselt er nur zu xlreadwrite und bricht ab. Ich muss also nochmnal auf den Button klicken um das Programm abzuarbeiten. Allerdings ist das Programm dann im Write Modus, wenn man nicht direkt wieder auf IMPORT druckt, wo man ungewollte Änderungen am Dokument machen kann.

Hat jemand eine Idee ? Danke schon mal...

Gruß Holger

AW: Abarbeitung des Codes nach ChangeFileAccess xlReadWrite

05.09.2025 11:33:27

volti

Hallo Holger,

wenn die Mappe tatsächlich neu geladen wird, könnte ich mir vorstellen, dass auch der Code weg ist und nun mal neu gestartet werden muss.

Eine Idee wäre, den Nachfolgecode in eigener Sub über API-Timer nach einer gewissen Zeit zu starten.
Aber
a) weiß ich nicht, ob der Timer beim Umswitchen ggf. auch beendet würde
b) ob die Prozeduradresse nach dem Umswitchen noch gültig ist.

Einfach mal ausprobieren..
Gruß
Karl-Heinz

AW: Abarbeitung des Codes nach ChangeFileAccess xlReadWrite

05.09.2025 13:35:29

Marc

Durch das neu laden, wird der Code nicht mehr abgearbeitet aus der "alten" Mappe

ich würde das so lösen..

In eine Tabelle oder Zelle gibts den Wert 0 oder 1

0 = Schreibgeschützt
1 = nicht schreib geschützt

Im Bereich Workbbook --> Open

schreibst du die Routine rein

Wenn Wert der Zelle = 1
führen den Code aus (der Code der bei dir hinter dem Reload der Datei kommt, wenn du Schreibschutz entfernst)
Sonst nicht

Dann brauchst du in dem Sub, in dem du Schreibschutz aktivierst oder deaktivierst nur noch jeweil in der spezifischen Zelle ein 0 oder 1 zu hinterlegen...
So übergibst du kwasi bei Neustart der Datei, die Anforderungen zum starten der restlichen Code Sequenz



Private Sub Workbook_Open()

ThisWorkbook.Activate

If Sheets("Daten").Range("A1") = 1 Then

'Hier kommt dein Code rein, wenn die Datei beschrieben werden darf

End If

End Sub



Public Sub Schreibschutz

ThisWorkbook.Active



If Sheets("Daten").Range("A1") = 1 Then

 Sheets("Daten").Range("A1") = 0

MsgBox "Schreibschutz wird aktiviert",vbOKOnly

'deine Routine zum aktivieren des Schreibschutzes

Else

Sheets("Daten").Range("A1")  = 1

MsgBox "Schreibschutz wird deaktiviert"

'Deine Routine zum deaktiveren des Schreibschutzes und neu laden 

End If

End Sub

AW: Abarbeitung des Codes nach ChangeFileAccess xlReadWrite

08.09.2025 12:35:30

f4rgun4no

Hi!

Verstehe ich das richtig?
Du arbeitest aus einer File heraus die sich selber beim Laden automatisch einen Schreibschutz verpasst.
Dann läuft dein Makro nicht mehr, korrekt?

Ich habe vllt etwas brauch- & vergleichbares zuletzt mit Hilfe einer 2ten File gelöst, die mit den Blattschutz samt PW in allen Sheets setzt oder rausnimmt.
Dann kann ich bearbeiten & am Ende den Schutz wieder setzen, bzw, der wird bei mirt auch beim Laden der zu bearbeitenden File automatisch gesetzt, damit man nciht mal eben die Hyperlinks durcheinander schmeißt.

Die Blattschutzfile öffne ich halt per Hyperlink aus meinem zu bearbeitenden Dokument.

Für dich vlt brauchbares hab ich Fett markiert.

Im Modul1 der Balttschutz-File
Option Explicit
Global ausgabe As String

Sub test()
Dim wbA As Workbook
Dim wsA As Worksheet

Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long

Dim FilNam1 As String
Dim FilPfa1 As String
Dim BlatNam1 As String

Dim FilNam2 As String
Dim FilPfa2 As String

FilNam1 = "Blattschutz-File.xlsm"
FilPfa1 = "M:\xxx\Sicherungen"
BlatNam1 = "Blattschutz für Anlagenliste"

FilNam2 = "Anlagenliste.xlsx"
FilPfa2 = "M:\xxx\"

Set wbA = ActiveWorkbook
Set wsA = wbA.Worksheets(BlatNam1)

For i = 1 To Workbooks.Count
'MsgBox Workbooks(i).Name
If Workbooks(i).Name = FilNam2 Then
'Workbooks(i).Activate
Exit For
End If

If i = Workbooks.Count Then
MsgBox "Abbruch!" & vbCrLf & "Datei ist nicht geöffnet!"
Exit Sub
End If

Next i

'Workbooks.Open FilNam2
Workbooks(FilNam2).Activate
'ThisWorkbook.Activate
Workbooks(FilNam2).Sheets(1).Select

'MsgBox Sheets.Count

wsA.Range("C10:D11").Value = ""
wsA.Range("c11:d11").Font.ColorIndex = xlAutomatic
wsA.Range("H4:J25").Value = ""

wsA.Range("C10").Value = "EIN"
wsA.Range("C11").Value = "AUS"

For j = 1 To Sheets.Count
wsA.Cells(3 + j, 8).Value = j
wsA.Cells(3 + j, 9).Value = Workbooks(FilNam2).Sheets(j).Name
If Workbooks(FilNam2).Sheets(j).ProtectContents = True Then
wsA.Cells(3 + j, 10).Value = "EIN"
wsA.Range("D10").Value = wsA.Range("D10").Value + 1
End If
If Workbooks(FilNam2).Sheets(j).ProtectContents = False Then
wsA.Cells(3 + j, 10).Value = "AUS"
wsA.Range("D11").Value = wsA.Range("D11").Value + 1
End If
Next j

If wsA.Range("D10").Value > wsA.Range("D11").Value Then
'alle Blattschutz aufheben
For k = 1 To Workbooks(FilNam2).Sheets.Count
Workbooks(FilNam2).Sheets(k).Unprotect "qwertz"
Next k
Else
'alle Blattschutz setzen
For l = 1 To Workbooks(FilNam2).Sheets.Count
Workbooks(FilNam2).Sheets(l).Protect "qwertz"
Next l
End If

wsA.Range("D10:D11").Value = ""
wsA.Range("c10:d11").Interior.ColorIndex = xlNone
'wsA.Range("D10").Interior.corlorindex = xlNone

For j = 1 To Sheets.Count
wsA.Cells(3 + j, 8).Value = j
wsA.Cells(3 + j, 9).Value = Workbooks(FilNam2).Sheets(j).Name
If Workbooks(FilNam2).Sheets(j).ProtectContents = True Then
wsA.Cells(3 + j, 10).Value = "EIN"
wsA.Range("c10:d10").Interior.ColorIndex = 4
wsA.Range("D10").Value = wsA.Range("D10").Value + 1
End If
If Workbooks(FilNam2).Sheets(j).ProtectContents = False Then
wsA.Cells(3 + j, 10).Value = "AUS"
wsA.Range("c11:d11").Interior.ColorIndex = 3
wsA.Range("c11:d11").Font.ColorIndex = 2
wsA.Range("D11").Value = wsA.Range("D11").Value + 1
End If
Next j

Workbooks(FilNam2).Sheets(1).Select

Application.DisplayAlerts = False
Workbooks(FilNam2).Save
Workbooks(FilNam1).Save
Application.DisplayAlerts = True

End Sub

AW: Abarbeitung des Codes nach ChangeFileAccess xlReadWrite

08.09.2025 10:26:44

Holger

Hallo,

erstmal vielen Dank für die Antwort.

Leider bringt es nichts, etwas in eine Zelle zu schreiben um dann beim Neustart darauf zu reagieren. Die Datei beim Drücken auf den Butten readonly und Zellwerte werden daher nicht übernommen. Außerdem wird beim reloaden der Datei keinerlei Makro ausgeführt, was bei workbook.open hinterlegt ist, sonst würde die Datei ja auch wieder selbstständig in readonly gehen wegen dem hinterlegten Code.

Aktuell habe ich es gerade folgendermaßen umgesetzt, was ich sehr unschön finde, aber es funktioniert:

Ich rufe mit dem IMPORT-Button ein kleines externes Programm auf und schließe direkt danach die Haupt-Datei. (thisworkbook.close)
In der neuen Datei wird das per endlicher Schleife im Sekundentakt geprüft ob die Haupt-Datei bereits geschlossen ist und wenn ja, die Datei erneut geöffnet.
In der Haupt-Datei ist nun bei workbook.open eine Abfrage, ob die "kleine Mappe" geöffnet ist und wenn ja, gehe nicht in readonly und starte den Import Task und schließe die "kleine Mappe" . Wenn nicht, gehe nur readonly.
Da passiert einiges auf dem Bildschirm aber es funktioniert. Lässt sich auch schlecht mit Application.screenupdate verhindern, aber was solls.

AW: Abarbeitung des Codes nach ChangeFileAccess xlReadWrite

08.09.2025 12:50:37

Kuwer

Hallo Holger,

teste mal folgendes:

Sub StarteImport()

  Application.OnTime Now + TimeSerial(0, 0, 2), "MeinImportmakro"

  ThisWorkbook.Close False

End Sub



Private Sub MeinImportmakro()

  MsgBox "MeinImportmakro"

End Sub

Gruß, Uwe

Abarbeitung des Codes nach ChangeFileAccess xlReadWrite

Forumthread: Abarbeitung des Codes nach ChangeFileAccess xlReadWrite

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Abarbeitung des Codes nach ChangeFileAccess xlReadWrite

Forumthread: Abarbeitung des Codes nach ChangeFileAccess xlReadWrite

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread