Makro für die Bennenung von Arbeitsblättern (mit Überprüfung, ob der gewählter Name schon vorhanden ist)

' Benötigte Variablen festlegen  
 
    Dim NewTableName As String
    Dim Quelle, Ziel As Worksheet
    
    Set Quelle = ThisWorkbook.ActiveSheet
   
    If ActiveSheet.Name <> Range("B8") Then                'Abfrage stellt sicher, daß das Arbeitsblatt  
    ActiveSheet.Name = Range("B8")                           'den Projektnamen enthält und keinen  
    End If                                                                             'beliebigen Text  
   
    Set Ziel = ThisWorkbook.Worksheets.Add(After:=Sheets(Sheets.Count))
    
    NewTableName = Quelle.Range("$B$8").Value     'Das neue Blatt bekommt einen festen Namen aus dem Quellblatt  
    
    
 ' Neues Blatt mit weißem Hintergrund versehen  
    
    
    Ziel.Cells.Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Ziel.Name = "Auswertung " & NewTableName  
    
    On Error Resume Next        '*** Falls Blattname bereits existiert ***  

'Kopieraufträge aus Ursprungsblatt [...]  

    Dim NewTableName As String
    Dim Quelle, Ziel As Worksheet
    
    Pre = "Auswertung " 'Präfix für neue Tabellennamen  

    After = "Auswertungen >>>" 'Blatt, nach dem das neue Blatt eingefügt werden soll  

    NewSheet = Pre & ActiveSheet.Name
    
    
    Set Quelle = ThisWorkbook.ActiveSheet
   
    If ActiveSheet.Name <> Range("B8") Then 'Abfrage stellt sicher, daß das Arbeitsblatt  
    ActiveSheet.Name = Range("B8")          'den Projektnamen enthält und keinen  
    End If                                  'beliebigen Text  
    


Counter = 1

LNew = Len(NewSheet) 'Länge des neuen Tabellennamens (wird mehrfach benötigt und daher hier nur einmal ermittelt)  



For Each Sheet In Sheets 'alle Blätter durchgehen  

    ThisName = Sheet.Name 'Name des betrachteten Blattes  

    If Left(ThisName, LNew) = NewSheet Then 'beginnt der Name dieses Blattes so wie jener des neu zu erstellenden Blattes?  

        If ThisName <> NewSheet Then 'ja, ist aber nicht gleich (daher bereits mit Laufnummer)  

            Nr = Val(Evaluate(Mid(Sheet.Name, LNew + 1))) 'Laufnummer ermitteln ...  

            If Nr >= Counter Then Counter = Nr + 1 '... und erhöhen  

        Else 'Blatt mit dem selben Namen wie das neu zu erstellende Blatt existiert  

            If Counter < 2 Then Counter = 2 'Laufnummer nur auf 2 setzen, wenn noch noch nicht mindestens 2  

        End If

    End If

Next



Set Ziel = Worksheets.Add(After:=Sheets(After))   'Blatt nach dem vorgegebenen Blatt einfügen ... (=> von mir noch als "Ziel" definiert, damit die Kopieraufträge entsprechend ausgeführt werden können)  

 ' Neues Blatt mit weißem Hintergrund versehen  
    Ziel.Cells.Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With


'... und benennen (nur wenn Laufnummer > 1 auch mit Zusatz)  



If Counter > 1 Then ActiveSheet.Name = NewSheet & " (" & CStr(Counter) & ")" Else ActiveSheet.Name = NewSheet  


On Error Resume Next '*** Falls Blattname bereits existiert ***  

Option Explicit

'*** Definition der benötigten Variablen  

Dim i As Integer   '*** Zählervariable  
Dim Anz As Integer '*** Anzahl der vorhandenen Blätter  
Dim s As Boolean   '*** Speichervariable  
Dim Hinweis As Byte
Dim Cancel As Boolean



'********************************************************************************************  

'*** Was muss beim bzw. vor dem Öffnen der Arbeitsmappe passieren?  
'***  
'*** Es werden alle Blätter der Arbeitsmappe ausgeblendet und der zu bestätigende Disclaimer  
'*** aufgerufen - erst nach dessen Bestätigung werden die restlichen Blätter sichtbar.  
'***  
'*** Das Blatt "MakroHinweis" enthält einen Warntext, der nur erscheint, wenn die Makro-  
'*** sicherheit von Excel zu hoch eingestellt ist und somit eine korrekte Ausführung  
'*** der Arbeitsmappe nicht gewährleistet ist. In diesem Fall erscheint ausschließlich  
'*** das Blatt "MakroHinweis", alle anderen Blätter sollen über [xlVeryHidden] aus-  
'*** geblendet werden.  

'********************************************************************************************  


Private Sub Workbook_Open()

Anz = ActiveWorkbook.Sheets.Count

Application.ScreenUpdating = False

'*** Alle vorhandenen Arbeitsblätter werden gezählt und anschließend in einer Schleife vom   
'*** letzten Blatt bis zum ersten Blatt (in -1 Schritten) heruntergezählt - es gibt zunächst   
'*** keine Begrenzung nach oben (die Anzahl der Blätter betreffend), alle werden mit eingeschlossen.  

For i = Sheets.Count To 1 Step -1  
Sheets(i).Visible = False  
Next i  


'*** Dieses Arbeitsblatt wird ausgeblendet, wenn die Makrosicherheit ausgeschaltet ist.  
Sheets("MakroHinweis").Visible = False   

Sheets(Anz).Visible = False

'*** Diese Blatt enthält einen separat zu bestätigenden Disclaimer - erst danach werden die restlichen Blätter eingeblendet.  
Sheets("Disclaimer").Select         

Application.ScreenUpdating = True

End Sub



'********************************************************************************************  

'*** Was muss vor dem Schließen der Arbeitsmappe passieren?  
'***  
'*** Vor dem Schließen der Arbeitsmappe müssen erst alle enthaltenen Blätter wieder mit  
'*** [xlVeryHidden] versehen werden , so dass diese nicht versehentlich ohne den Sichtschutz  
'*** abgespeichert werden.  
'*** Einzige Ausnahme ist das Blatt "MakroHinweis", welches sichtbar sein soll, falls die  
'*** Excel das Ausführen von Makros nicht zuläßt.  

'*** aufgerufen - erst nach dessen Bestätigung werden die restlichen Blätter sichtbar.  
'***  
'*** Das Blatt "MakroHinweis" enthält einen Warntext, der nur erscheint, wenn die Makro-  
'*** sicherheit von Excel zu hoch eingestellt ist und somit eine korrekte Ausführung  
'*** der Arbeitsmappe nicht gewährleistet ist. In diesem Fall erscheint ausschließlich  
'*** das Blatt "MakroHinweis", alle anderen Blätter sollen über [xlVeryHidden] aus-  
'*** geblendet werden.  

'********************************************************************************************  


Private Sub Workbook_BeforeClose()

If ActiveWorkbook.Saved Then

    Sheets("MakroHinweis").Visible = True  

        For i = Sheets.Count To 1 Step -1

            If Sheets(i).Name <> "MakroHinweis" Then Sheets(i).Visible = xlVeryHidden  

        Next i

    s = True

    ThisWorkbook.Close True

Else

    If s = True Then Exit Sub

    Hinweis = MsgBox("Wollen Sie Ihre Änderungen vor dem Schließen der Arbeitsmappe abspeichern", _  
    vbYesNo + vbQuestion + vbExclamation, "Änderungen abspeichen?", "", 0)  

        If Hinweis = 6 Then ' Die Abfrage des Hinweisfensters wurde "Ja" beantwortet  

            Application.ScreenUpdating = False

            Sheets("MakroHinweis").Visible = True  

             For i = Sheets.Count To 1 Step -1

                If Sheets(i).Name <> "MakroHinweis" Then Sheets(i).Visible = xlVeryHidden  
    
             Next i

            Application.ScreenUpdating = True

            s = True

            ThisWorkbook.Save

        Else

            s = True

            ThisWorkbook.Close False

        End If

End If

End Sub

 For Each wks In Sheets
        Application.ScreenUpdating = False
        If wks.Name <> "MakroHinweis" Then wks.Visible = True  
Next

Option Explicit

Private Sub Workbook_Open()
Dim Anz, i
Anz = ActiveWorkbook.Sheets.Count

For i = Sheets.Count To 2 Step -1     'Blatt 1 ist der Disclaimer und von der Schleife ausgenommen.  

   Application.ScreenUpdating = False
   Sheets(i).Visible = False
   
Next i

Sheets(Anz).Visible = False

Sheets("Sheet_Disclaimer").Select  

End Sub

Private Sub chkAccept_Click()
  On Error Resume Next
  Call DisclaimerAccept(chkAccept.Value)
End Sub

Private Sub CheckBox1_Click()

End Sub

Private Sub Auto_Open()
Sheets("Disclaimer").Activate  
Sheet_Disclaimer.[b3] = False    'Der Disclaimer wird beim Laden der Arbeitsmappe zurückgesetzt und muss nach jedem Start neu bestätigt werden, bevor alle Arbeitsblätter eingeblendet werden.  

End Sub

Option Explicit

Sub DisclaimerAccept(blnAccepted As Boolean)

Dim sh As Variant
  
  Application.ScreenUpdating = False

  For Each sh In ThisWorkbook.Sheets
    If blnAccepted Then
      sh.Visible = xlSheetVisible
    Else
      If sh.CodeName <> "Sheet_Disclaimer" Then sh.Visible = xlSheetVeryHidden  
    End If

  Next sh
  
End Sub

 For Each sh In ThisWorkbook.Sheets
    If blnAccepted Then
      sh.Visible = xlSheetVisible
    Else
      If sh.CodeName <> "Sheet_Disclaimer" Then sh.Visible = xlSheetVeryHidden  
    End If

  Next sh
  

Dim wks As Worksheet

 For Each wks In Sheets
        Application.ScreenUpdating = False
        If wks.Name <> "MakroHinweis" Then wks.Visible = True  
Next

Private Sub chkAccept_Click()
  On Error Resume Next
  Call DisclaimerAccept(chkAccept.Value)
End Sub