Document ID: /fineweb-2-swissfilter-quality_10-filterrobots/filtered/03287.jsonl.gz/1592

Tipps & Tricks 07.09.2002, 16:15 Uhr
Ein Tabellenblatt in mehreren Dateien per Knopfdruck schützen
Ich bin auf der Suche nach einem Makro das folgende Funktionalität erfüllt: Schützen eines Tabellenblattes in allen Dateien, die sich in einem Ordner befinden. Die Tabellenblätter in den Dateien haben alle konsistente Namen (Mai2002 Juni2002) und ich möchte aus einer Control-Datei, die sich ebenfalls in diesem Verzeichnis befindet durch Knopfdruck in den restlichen Dateien das jeweilige Blatt schützen.
Angenommen die Dateien in denen Sie ein bestimmtes Blatt schützen möchten befinden sich im Verzeichnis C:\Eigene Dateien\Verzeichnis. Mappe1 bis Mappe7 und die Control-Datei namens ControlDatei.
In der ControlDatei.xls benötigen wir nun eine Liste mit allen vorhandenen Dateinamen. Der Einfachheit halber wird in Zelle B1 eruiert, wieviele Dateinamen insgesamt vorhanden sind. Diese Zahl wird mit der Funktion =Anzahl2(A:A)-1 ermittelt. Im gelben Feld wird der zu schützende Blattname eingetragen (hier Mai2002)
Erstellen Sie nun folgendes Makro in der Control-Datei (Am Ende finden Sie das Makro in Textform, damit sie es kopieren können):
Nun fügen sie noch einen Button in die Control-Datei ein, hier ein Formularbutton, und weisen dieser Schaltfläche das eben erstellte Makro zu.
Wenn Sie nun auf diesen Button klicken, werden die eingetragenen Dateien nacheinander geöffnet, das entsprechende Blatt geschützt, die Datei gespeichert und wieder geschlossen.
---------------------------------------
Makrocode zum kopieren:
Ersetzen sie die Zeichen ""
bei Pfad: durch Gänsefüsschen
---------------------------------------
Sub BlaetterSchuetzen()
Dim Z As Variant
Dim Datei, Blatt, Pfad As String
Pfad = "C:\Eigene Dateien\Verzeichnis\"
Blatt = [E1].Formula
Z = [b1].Value + 2
[A2].Select
Do Until ActiveCell.Row = Z
Datei = ActiveCell.Formula
Workbooks.Open Filename:=Pfad & Datei
Sheets(Blatt).Select
ActiveSheet.Protect
ActiveWorkbook.Save
ActiveWindow.Close
ActiveCell.Offset(1, 0).Select
Loop
End Sub
---------------------------------------
Kommentare
Es sind keine Kommentare vorhanden.