Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
' Länge des Texts in G8 prüfen...
If Len(ActiveSheet.Cells(8, 7).Value) > 0 And _
Len(ActiveSheet.Cells(8, 7).Value) < 32 Then
' Gleichheit von Text in G8 und Blattname prüfen...
If ActiveSheet.Cells(8, 7).Value <> _
ActiveSheet.Name Then
' Existenz des Blattnames prüfen...
If Not SheetExists(ActiveSheet.Cells(8, 7).Value) Then
' Umbenennen...
ActiveSheet.Name = ActiveSheet.Cells(8, 7).Value
End If
End If
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
' Target auf G8 (Zeile 8, Spalte 7) prüfen...
If Target.Row = 8 And Target.Column = 7 Then
' Länge des Texts aus Target prüfen...
If Len(Target.Value) > 0 And _
Len(Target.Value) < 32 Then
' Existenz des Blattnames prüfen...
If Not SheetExists(Target.Value) Then
' Umbenennen...
ActiveSheet.Name = Target.Value
End If
End If
End If
End Sub
Private Function SheetExists(strName As String) As Boolean
On Error Resume Next
SheetExists = Not Sheets(strName) Is Nothing
End Function