31 Aufrufe
Gefragt in Tabellenkalkulation von dani89 Einsteiger (14 Punkte)
Bearbeitet von halfstone

Wie muss ich folgendes umstellen damit er mir die gesamte Arbeitsmappe schützt nach der eingabe und dem speichern, nur nur die Zellen auf Blatt 1

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim zelle As Range
    Sheets(1).Unprotect
    For Each zelle In Sheets(1).UsedRange
        If zelle.Value <> "" Then
            zelle.Locked = True
        Else
            zelle.Locked = False
        End If
    Next
    Sheets(1).Protect
End Sub

4 Antworten

0 Punkte
Beantwortet von m-o Profi (13.2k Punkte)
Hallo,

sollen alle Tabellenblätter - und wie im Beispiel nur die leeren Zellen - geschützt werden oder soll die ganze Tabelle mit einem Schutz versehen werden, d.h. die Tabelle lässt sich z.B. nur nach Eingabe eines Passwortes öffnen und bearbeiten.

Gruß

M.O.
0 Punkte
Beantwortet von dani89 Einsteiger (14 Punkte)
hallo,

ich habe 6 tabelblätter angelegt. so wie das geschrieben ist, schützt er mir nach der eingabe die zellen in denen was geschrieben steht nur in Tabelle. auf den anderen Tabellenblättern geschiet dadurch ncihts. Dort möchte ich es aber genau so haben wenn das gehen sollte.

Möchte nur ungern die ganze Arbeitsmappe mit der "schutz" funktion von excel versehen da die liste von mehreren bearbeitet wird und ich nicht jedem das passwort geben kann und will.

gruß daniel
0 Punkte
Beantwortet von m-o Profi (13.2k Punkte)
ausgewählt von halfstone
 
Beste Antwort

Hallo Daniel,

hier ist der angepasste Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
Dim zelle As Range
Dim i As Long

'Alle Arbeitsblätter der Arbeitsmappe durchlaufen
For i = 1 To ThisWorkbook.Worksheets.Count

 With Worksheets(i)
    'Schutz aufheben
    .Unprotect
    For Each zelle In .UsedRange
        If zelle.Value <> "" Then
            zelle.Locked = True
        Else
            zelle.Locked = False
        End If
    Next
    'Schutz wieder einrichten
    .Protect
  End With
Next i
     
End Sub

Gruß

M.O.

0 Punkte
Beantwortet von dani89 Einsteiger (14 Punkte)
super danke, genau das hab ich gesucht! funktioniert perfekt ;)
...