Arbeitsblattnamen eingeben

Hallo Profis,

ich habe folgenden etwas umständlichen aber funktionierenden Makro, um mein Tabellenblatt automatisch zu benennen und im Problemfall den Namen manuell eingeben zu können.
Der einzige Fehler, der noch nicht berücksichtig ist, ist der, dass der Blattname bereits vorhanden ist.
Wie kann ich diese Abfrage mit möglichst wenig Aufwand in den bestehenden Makro einbauen?
Vielen Dank für die Hilfe,

Janine

sheetsname = Range("C5").Value
If Len(sheetsname) > 31 Then
Do
sheetsname = InputBox("Kennzahl für Blattnamen zu lang! Blattnamen bitte manuell eingeben (max 31 Zeichen): ", "Text eingeben...")
If CBool(InStr(1, sheetsname, "/")) _
Or CBool(InStr(1, sheetsname, "\")) _
Or CBool(InStr(1, sheetsname, ":")) _
Or CBool(InStr(1, sheetsname, "?")) _
Or CBool(InStr(1, sheetsname, "[")) _
Or CBool(InStr(1, sheetsname, "]")) _
Or CBool(InStr(1, sheetsname, "*")) Then
MsgBox "Sonderzeichen nicht zulässig!"
sheetsname = "Dummy Dummy Dummy Dummy Dummy Dummy Dummy"
End If
Loop While Len(sheetsname) > 31
ElseIf CBool(InStr(1, sheetsname, "/")) _
Or CBool(InStr(1, sheetsname, "\")) _
Or CBool(InStr(1, sheetsname, ":")) _
Or CBool(InStr(1, sheetsname, "?")) _
Or CBool(InStr(1, sheetsname, "[")) _
Or CBool(InStr(1, sheetsname, "]")) _
Or CBool(InStr(1, sheetsname, "*")) Then
Do
sheetsname = InputBox("Ungültiges Sonderzeichen in Blattname! Blattname bitte manuell eingeben (max 31 Zeichen): ", "Text eingeben...")
If CBool(InStr(1, sheetsname, "/")) _
Or CBool(InStr(1, sheetsname, "\")) _
Or CBool(InStr(1, sheetsname, ":")) _
Or CBool(InStr(1, sheetsname, "?")) _
Or CBool(InStr(1, sheetsname, "[")) _
Or CBool(InStr(1, sheetsname, "]")) _
Or CBool(InStr(1, sheetsname, "*")) Then
MsgBox "Sonderzeichen nicht zulässig!"
sheetsname = "Dummy Dummy Dummy Dummy Dummy Dummy Dummy"
End If
Loop While Len(sheetsname) > 31
End If
Range("C4").Value = sheetsname
Sheets("Vorlage Balkendiagramm (2)").Select
ActiveSheet.name = Worksheets("Auswertungstabelle").Range("C4").Value

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

''written by L.Vira for softsmith, mailto softsmith@web.de
''Zur freien Verwendung ohne jegliche Garantie!
Option Explicit
Sub Blatt_benennen()
Dim sheetname As String
''Das Makro darf nur vom Blatt "Auswertungstabelle" aus
''ausgeführt werden.
sheetname = [c5]
If [c5] = "" Then
MsgBox "Die Zelle C5 ist leer! ", 64, "weise hin..."
Exit Sub
End If
If Len([c5]) > 31 Then
MsgBox "Die Länge des Namens darf max. 31 betragen! " & Chr(10) & _
"aktuell sind es " & Len([c5]) & " Zeichen!", 64, "weise hin..."
Exit Sub
End If
If Verbot(sheetname) Then Exit Sub
If ShName(sheetname) Then Exit Sub
[c4] = sheetname
''Ich hoffe mal, du weißt, dass der Code nur einmal ausgeführt
''darf, weil es nach dem ersten Durchlauf das Blatt
''"Vorlage Balkendiagramm (2)" nicht mehr gibt!
Sheets("Vorlage Balkendiagramm (2)").Select
ActiveSheet.Name = Sheets("Auswertungstabelle").[c4]
End Sub
Function Verbot(Text As String) As Boolean
Dim x As Variant
Verbot = False
For Each x In Array("""", "?", ":", "|", "<", ">", "/", "\", "*")
If InStr(Text, x) > 0 Then
Verbot = True
MsgBox "Folgende Zeichen sind in Dateinamen nicht erlaubt: " & Chr(10) & Chr(10) & _
" * | > < '' ? / \ : ", 64, "gebe bekannt..."
Verbot = True
Exit For
End If
Next
End Function
Private Function ShName(BName As String)
Dim Sh As Object
ShName = False
For Each Sh In ActiveWorkbook.Sheets
If UCase(Sh.Name) = UCase(BName) Then
MsgBox "Das Blatt " & Sh.Name & " ist schon vorhanden!" & Space(10), 64, "weise hin..."
ShName = True
Exit For
End If
Next
End Function

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread