Blattschutz

Question

Hallo,

noch eine Frage zu VBA. Ich habe ein Makro, welches mir beim durchführen bestimmte Zellen zusätzlich Sperren soll.

Szenario ist, dass das Blatt schon geschützt ist und bestimmte Zellen gesperrt. Nun soll beim durchlaufen des Makros zusätzliche Zellen in 7 Datenblättern gesperrt werden.

Dann möchte ich noch ein Makro haben, welches die zusätzlich gesperrten Zellen wieder entsperren kann.

Das ganze dient einem Dienstplanprogram. Der Gruppenleiter schreibt bislang die Zeiten in dem Datenblatt der Hauptübersicht und überträgt die bislang mit einem Makro auf die jeweiligen Mitarbeiterdatenblätter.

Nun soll das aber nur noch der Gruppenleiter die Daten ändern können, sprich, wenn er den Dienstplan in der Hauptübersicht fertig gemacht hat und das Makro zum übertragen benutzt, dann soll auch die Zellen mit den Zeiten gesperrt sein. Wenn er aber noch mal was ändern will, dann soll er eben mittels Makro die Zellen wieder entsperren können.

Damit niemand anderes die Makros benutzt habe ich schon was gefunden:

'PopUpFenster für eingabe des Passworts

If Not InputBox("Wie heißt das Zauberwort") = "simsalabim" Then
Exit Sub

End If

Das Makro für die Übertragung ist hier.

Sub Daten_kopieren()

If Not InputBox("Wie heißt das Zauberwort") = "simsalabim" Then
Exit Sub
End If

ErrHandler:
Debug.Print "Zeile="; i; Err.Number, Err.Description
Resume Next



Dim Spalte As Integer, Gemerkte_Spalte As Integer, Zeile As Long, Spalte_auslassen As String

'=======================================================================================
'Bildschirmaktualisierung ausschalten. Unterbindet, dass der Bildschirm während der
'Abarbeitung des Makros nicht jeden Schritt zeigt und somit flimmert.
'=======================================================================================
Application.ScreenUpdating = False

'=======================================================================================
'Schleife zum Ermitteln, welche Zeile in dem Bereich C6:BO36, die letzte beschriebene
'Zeile ist. Dabei werden die Spalten M, X, AI, AT, BE und BP nicht berücksichtigt, da
'diese Formeln enthalten
'=======================================================================================
Spalte_auslassen = ",13,24,35,46,57,68,"
For Spalte = 3 To 69
If InStr(1, Spalte_auslassen, "," & CStr(Spalte) & ",") = 0 Then
If Zeile < Cells(38, Spalte).End(xlUp).Row + 1 Then
Zeile = Cells(38, Spalte).End(xlUp).Row
Gemerkte_Spalte = Spalte
End If
End If
Next
'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis01" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis01").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 3), Cells(Zeile, 13)).Copy
Worksheets("AZ-Nachweis01").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis02" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis02").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 14), Cells(Zeile, 24)).Copy
Worksheets("AZ-Nachweis02").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis03" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis03").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 25), Cells(Zeile, 35)).Copy
Worksheets("AZ-Nachweis03").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis04" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis04").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 36), Cells(Zeile, 46)).Copy
Worksheets("AZ-Nachweis04").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis05" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis05").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 47), Cells(Zeile, 57)).Copy
Worksheets("AZ-Nachweis05").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'=======================================================================================
'Daten ab Zeile 6 bis zu der vorher ermittelten letzten bschriebenen Zeile werden
'in Tabelle "AZ-Nachweis06" kopiert
'=======================================================================================
Worksheets("AZ-Nachweis06").Range("C6:M37").ClearContents
Worksheets("Dienstplanung MKT").Range(Cells(6, 58), Cells(Zeile, 68)).Copy
Worksheets("AZ-Nachweis06").Cells(6, 3).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End Sub





Bislang hab ich das mal ausprobiert.

Sub Zellen_entsperren()

'PopUpFenster für eingabe des Passworts

If Not InputBox("Wie heißt das Zauberwort") = "simsalabim" Then
Exit Sub


End If


'=======================================================================================
'Bildschirmaktualisierung ausschalten. Unterbindet, dass der Bildschirm während der
'Abarbeitung des Makros nicht jeden Schritt zeigt und somit flimmert.
'=======================================================================================

Application.ScreenUpdating = False


'=======================================================================================
'Datenblätter wieder entsperren und beschreibbar machen
'=======================================================================================

Workshe

Answer 1

Hallo Jumpanino,

ich habe mir Deine Makros nicht durchgesehen, aber nachfolgend mal ein Makro, dass Dir die Zellen A1, B1 und C1 sperrt, wenn in diese vorher trotz Blattschutz Eingaben möglich waren, weil unter "Zellen formatiern" im Register "Schutz" der Haken bei "Gesperrt" nicht gestzt war.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub Zellen_sperren()
With ActiveSheet
.Unprotect "simsalabim"
.Range("A1,B1,C1").Locked = True
.Protect "simsalabim"
End With
End SubDer 2 .Code hebt den Blattschutz für das Gesamte Blatt auf, damit man nachträglich Änderungen machen kann.

Kopiere auch dieses Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Auch hier wieder: Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Sub Zellenschutz_aufheben()
ActiveSheet.Unprotect "simsalabim"
End Sub

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 2

Hallo coros,

Vielen Dank für deinen Tipp aber ich habe es nun selbst hin bekommen. Ich habe in dem schon vorhandenen Makro einfach das so eingestellt, dass alle Zellen in den zu kopierenden Datenblättern gesperrt sind. DAmit aber trozdem kopiert werden kann, habe ich einfach jeweils einen Code

Worksheets("AZ-Nachweis05").Unprotect Password:="123"

und einen

Worksheets("AZ-Nachweis05").Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True

hingeschrieben.

Dann eben das Makro, welches eben nur in der Hauptübersich die betreffenden Zellen wieder entsperren kann.

Also das funktioniert nun so wie ich es mir gedacht habe. Die beiden Makros lassen sich nur per Passworteingabe ausführen womit gesichert ist, dass die Makros nur von berechtigten Personen benutzt werden.

Grüße Jumpanino