Tabellennamen Schützen vor Überschreiben
08.07.2005 17:07:51
Martin
mit dem folgenden VBA kann ich dank der Mithilfe einiger Forums-User, sicherstellen, dass keine neuen Tabellenblätter angelegt oder Kopiert werden können.
Wie kann ich nun zusäzlich noch die Tabellennamen vor Abänderung, Verschieben oder noch schlimmer dem Löschen schützen?
Unsere Anwender sind leider zu allem fähig.
Bei Tests wurden alle Tabellenblätter gelöscht wenn die Namen verändert wurden.
Das schützen der Arbeitsmappe kommt leider nicht in Frage oder ist nur bedingt geeignet.
'**** Gesammt VBA durch "IngGi" 80%, "UweD" 20% unterstützt erstellt****
'alle Makros unter "diese Arbeitsmappe" einfügen
'****Teil VBA von UweD ****
Private Sub Workbook_NewSheet(ByVal sh As Object)
On Error GoTo Fehler
Application.ScreenUpdating = False
MsgBox "Nicht erlaubt"
Application.DisplayAlerts = False
ActiveSheet.Delete
Fehler:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
'**** Teil von IngGi" ****
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Object, BName As String
If ThisWorkbook.Sheets.Count > 2 Then
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Meldeblatt" And sh.Name <> "Querry" Then BName = "Treffer"
Next sh
If BName = "Treffer" Then
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Meldeblatt" And sh.Name <> "Querry" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next sh
Else
MsgBox ("Die Datei enthält mehrere Blätter. " & _
"Es kann jedoch nur ein Blatt gespeichert werden. " & _
"Um die Datei speichern zu können, müssen Sie dem zu speichernden Blatt " & _
"den Namen " & Chr$(34) & "Meldeblatt" & Chr$(34) & " geben. Alle anderen Blätter " & _
"werden gelöscht. Kopieren Sie diese Blätter daher vor dem Speichern jeweils in " & _
"eine eigene Datei.")
Cancel = True
End If
End If
End Sub
Private Sub Workbook_SheetActivate(ByVal sh As Object)
If ThisWorkbook.Sheets.Count > 2 Then
MsgBox ("Sie haben ein neues Tabellenblatt eingefügt. " _
& "Beim Speichern der Datei werden alle Tabellenblätter mit Ausnahme des ersten gelöscht! " _
& "Verwenden Sie für eine neue Meldung bitte eine neue Datei!")
End If
End Sub
Danke für Eure Hilfe
Martin