Makro
30.05.2016 12:05:29
Katja
ich habe ein Problem mit einen Makro, welches ein ehemaliger Kollege vor Jahren schrieb und welches jetzt irgendwie nicht mehr klappt.
Deshalb benötige ich dringend eure Hilfe.
Ich habe euch mal einen Beispieldatei hochgeladen, damit ihr mich besser versteht.
https://www.herber.de/bbs/user/105861.xls
Beginnen soll das Makro seine Arbeit in Zelle B5.
Hier soll geprüft werden ob die Zelle gefüllt ist. Wenn Ja dann Zelle schützen und weiter gehen zur Zelle C5 prüfen wenn Ja dann schützen weiter zu D5, wenn nein nicht schützen und auch weiter zu D5 usw. Dieses soll bis G5 gemacht werden. Dann soll die Prüfung in der nächsten Zeile weitergehen und wieder bis zur Spalte G usw.
Geprüft soll eine Zeile aber nur dann werden wenn die erste Zelle einer Zeile gefüllt wurde. Es sollen nur die beschrieben Zelle geschützt werden, nicht aber die leeren.
Die Tabelle wird von diversen Kollegen bearbeitet. Der Schutz soll nur dann aufgehoben werden, wenn Eintragungen geändert werden müssen und nicht bei jeder neuen Eintragung. Die Zellen dürfen nicht gesperrt werden, da in diversen Zellen Hyperlinks aktiviert werden müssen.
Z.Z. Schützt dieses Makro aber alles und ich muss den Blattschutz immer Aufheben. Lästig.
Gibt es eigentlich eine Möglichkeit das Makro mittels VBA automatisch zu aktivieren, wenn ich die Datei öffne und eine Nachricht zu erhalten?
Sub Schutzmakro()
' Schutzmakro Makro
' Makro am 01.11.99 von N aufgezeichnet
' Tastenkombination: Strg+m
' Blattschutz entfernen
ActiveSheet.Unprotect
' Spalte der FF-Riss-Nr. ist die einzige durchlaufend besetzte Spalte,
' daher wird diese als Maß für das Auffüllen der Tabelle benutzt
' Der Cursor wird auf die erste mögliche Position in dieser Spalte gesetzt
Range("B5").Select
' Wir beginnen mit Zähler 1, da wir die erste Zelle mit möglichem Eintrag überprüfen wollen.
Counter = 0
' Schleife soll laufen, bis eine Zelle ohne Eintrag erreicht ist
' Überprüfung auf "NUL" genügt, da dann zumindest alle notwendigen Zellen geschützt sind.
Do
' Jetzt werden alle Zellen pro Zeile hintereinander weg geschützt.
Selection.Offset(Counter, 0).Locked = True
Selection.Offset(Counter, 1).Locked = True
Selection.Offset(Counter, 2).Locked = True
Selection.Offset(Counter, 3).Locked = True
Selection.Offset(Counter, 4).Locked = True
Selection.Offset(Counter, 5).Locked = True
' Zähler wird um 1 erhöht, die nächste Zeile ist dran.
Counter = Counter + 1
' Schleife beginnt erneut.
Loop Until Selection.Offset(Counter, 0).Value = ""
' kompletter Blattschutz für die gesamte Tabelle wir wieder eingerichtet
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Aktuelle Tabelle wird gesichert.
ActiveWorkbook.Save
End Sub
Danke
LG Katja