Und die Anzahl stimmt auch nicht
15.04.2006 19:31:58
Nepumuk
Hi,
man soll ja auch nur ein Zeichen eingeben können!!
Private Sub CommandButton1_Click()
Dim objSheet As Object, objRegEx As Object, objMatch As Object
Dim blnFound As Boolean
TextBox1.Value = Trim$(TextBox1.Value)
If TextBox1.Value <> "" Then
For Each objSheet In ThisWorkbook.Sheets
If objSheet.Name = TextBox1.Value Then
blnFound = True
Exit For
End If
Next
If Not blnFound Then
Set objRegEx = CreateObject("vbscript.regexp")
With objRegEx
.Global = True
.Pattern = "^[^\/\\:\*\?\[\]]{1,31}$"
.IgnoreCase = True
Set objMatch = .Execute(TextBox1.Value)
End With
If objMatch.Count > 0 Then
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Worksheets("Disziplin").Copy After:=Worksheets(2)
ActiveSheet.Name = TextBox1.Value
Worksheets("Menüe").Select
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
Unload Me
Else
MsgBox "Ihre Eingabe enthält ungültige Zeichen wie * : ? \ / [ ]" & vbLf & _
"Bitte geben Sie einen anderen Namen ein.", vbExclamation, "Hinweis"
With TextBox1
.SelStart = 0
.SelLength = .TextLength
.SetFocus
End With
End If
Else
MsgBox "Der Name ''" & TextBox1.Value & "'' ist schon vergeben." & vbLf & _
"Bitte geben Sie einen anderen Namen ein.", vbExclamation, "Hinweis"
With TextBox1
.SelStart = 0
.SelLength = .TextLength
.SetFocus
End With
End If
Else
MsgBox "Sie haben keinen Namen eingegeben.", vbExclamation, "Hinweis"
TextBox1.SetFocus
End If
Set objRegEx = Nothing
Set objMatch = Nothing
End Sub
Gruß
Nepumuk