Hallo,
warum schützt du nicht einfach die Arbeitsmappenstruktur? (Datei --> Informationen --> Arbeitsmappe schützen --> Arbeitsmappenstruktur schützen.) Damit kann keiner Änderungen an den Sheets vornehmen.
Eine alternative Codelösung könnte z.B. so aussehen:
Füge ein Klassenmodul „Klasse1“ ein.
Füge darin den folgenden Code ein:
Dim wbop As String
Dim wbcalc As Integer
Dim shdel As String
Dim shcount As Integer
Public WithEvents app As Application
Private Sub app_AfterCalculate()
On Error GoTo Fehler:
Dim shtest As String
Dim erno As Byte
If ActiveWorkbook.Name = ThisWorkbook.Name And wbcalc = 0 Then
'prüft ob ein Sheet gelöscht wurde
erno = 1
If shdel <> "" Then
shtest = Sheets(shdel).Name
End If
'prüft ob ein sheet kopiert wurde
If shcount <> 0 Then
If ThisWorkbook.Sheets.Count > shcount Then
MsgBox "Sie haben Tabellenblatt " & ActiveSheet.Name & " kopiert"
End If
End If
'prüft ob ein Sheet umbenannt oder kopiert wurde
If wbop = "" Then
MsgBox "Sie haben ein Tabellenblatt in " & ActiveSheet.Name & " umbenannt oder nach " & ActiveSheet.Name & " kopiert."
End If
End If
wbcalc = wbcalc + 1
If wbcalc > 1 Then wbcalc = 0
wbop = ""
Exit Sub
Fehler:
If erno = 1 Then
MsgBox "Sie haben " & shdel & " gelöscht"
ElseIf erno = 2 Then
MsgBox "Sie haben " & ActiveSheet.Name
End If
Err.Clear
shdel = ""
End Sub
Private Sub app_SheetDeactivate(ByVal Sh As Object)
shcount = ThisWorkbook.Sheets.Count
shdel = Sh.Name
wbcalc = 0
End Sub
Private Sub app_WorkbookNewSheet(ByVal Wb As Workbook, ByVal Sh As Object)
'Prüft ob eine neues Sheet hinzugefügt wurde
If Wb.Name = ThisWorkbook.Name Then
MsgBox "Sie haben das Tabellenblatt " & Sh.Name & " hinzugefügt."
End If
End Sub
Private Sub app_WorkbookOpen(ByVal Wb As Workbook)
If Wb.Name = ThisWorkbook.Name Then
wbop = Wb.Name
shcount = Wb.Sheets.Count
End If
End Sub
Anschließend fügst du bei diese Arbeitsmappe diesen Code ein:
Dim x As New Klasse1
Private Sub Workbook_Open()
Set x.app = Application
End Sub
Schließe die Arbeitsmappe und öffne sie neu. Nun sollte es gehen.
PS: Vergiss nicht als xlsm zu speichern.
L.G. Mr. K.