Sheet löschen und sheet insert verhindern

Sub Protect() Worksheets(4).Activate ActiveSheet.Protect "test", _ DrawingObjects:=True, _ Contents:=True, Scenarios:=True, _ AllowFormattingCells:=True, _ AllowFormattingColumns:=True, _ AllowFormattingRows:=False, _ AllowInsertingColumns:=False, _ AllowInsertingRows:=False, _ AllowInsertingHyperlinks:=False, _ AllowDeletingColumns:=False, _ AllowDeletingRows:=False, _ AllowSorting:=False, _ AllowFiltering:=False, _ AllowUsingPivotTables:=False End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Eve,
außer der von Chris beschriebenen Methode den Schutz der Mappe ein-/auszuschalten gibt es noch die die Möglichkeit dem Anwender "auf die Finger zu schlagen" wenn er/sie es versucht.
Nachfolgender Code (in DieseArbeitsmappe) löscht nach Meldung ein neues Blatt sofort wieder, nach Löschen eines Blattes wird die Datei ohne Speichern geschlossen, bei Änderung des Namens eines Blattes wird dieser beim Speichern bzw. Wechsel auf ein anderes Blatt wieder zurückgeändert.
Voraussetzung ist natürlich, dass man die Datei nur mit aktivierten Makros bearbeiten kann. D.h. relevante Tabellenblätter werden beim Öffnen per Makro auf sichtbar geschaltet und beim schließen der Datei wieder ausgeblendet. Wer die Makros nicht aktiviert sieht dann nur ein Blatt mit einem entsprechenden Hinweis.
Gruß
Franz


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Überwachung Umbenennung
Dim Namen, Blatt, Neu As Boolean, Blattneu() As Boolean, I%
Namen = Array("Tabelle1", "Tabelle2", "Tabelle3") 'zulässige/gültige Namen
ReDim Blattneu(UBound(Namen))
For Each Blatt In ThisWorkbook.Sheets
For I = 0 To UBound(Namen)
Neu = True
If Blatt.Name = Namen(I) Then
Neu = False
Blattneu(I) = True
Exit For
End If
Next
If Neu = True Then
MsgBox "Es dürfen keine Tabellenblätter umbenannt werden. Blatt wird wieder umbenannt!"
For I = 0 To UBound(Namen)
If Blattneu(I) = False Then
Blatt.Name = Namen(I)
Exit For
End If
Next
Exit For
End If
Next
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Überwachung der Tabellenblätter
Dim Anzahl%, Namen, Blatt, Neu As Boolean, Blattneu() As Boolean, I%
Anzahl = 3 'Anzahl Register
Namen = Array("Tabelle1", "Tabelle2", "Tabelle3") 'zulässige/gültige Namen
If ThisWorkbook.Sheets.Count <> Anzahl Then
If ThisWorkbook.Sheets.Count < Anzahl Then
MsgBox "Es dürfen keine Tabellenblätter gelöscht werden. Datei wird geschlossen!"
ThisWorkbook.Close savechanges:=False
Else
MsgBox "Es dürfen keine Tabellenblätter hinzugefügt werden. Blatt wird gelöscht!"
For Each Blatt In ThisWorkbook.Sheets
Neu = True
For I = 0 To UBound(Namen)
If Blatt.Name = Namen(I) Then
Neu = False
Exit For
End If
Next
If Neu = True Then
Application.DisplayAlerts = False
Blatt.Delete
Application.DisplayAlerts = True
End If
Next
End If
Else
'Überwachung Umbenennung
ReDim Blattneu(UBound(Namen))
For Each Blatt In ThisWorkbook.Sheets
For I = 0 To UBound(Namen)
Neu = True
If Blatt.Name = Namen(I) Then
Neu = False
Blattneu(I) = True
Exit For
End If
Next
If Neu = True Then
MsgBox "Es dürfen keine Tabellenblätter umbenannt werden. Blatt wird wieder umbenannt!"
For I = 0 To UBound(Namen)
If Blattneu(I) = False Then
Blatt.Name = Namen(I)
Exit For
End If
Next
Exit For
End If
Next
End If
End Sub

Beliebteste Forumthreads (12 Monate)

Sheet löschen und sheet insert verhindern

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread