Doppeleingabe mit Laufzeitfehler 1004
19.05.2020 20:02:30
Joseph
https://www.herber.de/bbs/user/137635.xlsm
Sub KfzEintragen()
Dim blnFalsch As Boolean
Dim strName As String
Dim arrFalsch()
Dim bytFalsch As Byte
arrFalsch = Array("*", "[", "]", "/", "\", "?")
strName = InputBox("Kennzeichen des neuen Kfz:", "Kennzeichen eingeben")
'Dim TXT$
'TXT = strName
' TXT = Replace(TXT, " ", "")
' TXT = Replace(TXT, "-", "")
' MsgBox TXT
'strName = TXT
If strName = "" Then
MsgBox "Es wurde kein Kennzeichen eingegeben!"
blnFalsch = True
Else
If IsError(Evaluate(strName & "!A1")) Then
If Len(strName) > 10 Then
MsgBox "Maximal 10 Zeichen erlaubt"
blnFalsch = True
Else
For bytFalsch = 0 To 5
If InStr(strName, arrFalsch(bytFalsch)) > 0 Then
MsgBox "Unerlaubte Zeichen enthalten"
blnFalsch = True
Exit For
End If
Next bytFalsch
End If
Else
Application.DisplayAlerts = False
MsgBox "Kfz schon vorhanden"
blnFalsch = True
End If
End If
If blnFalsch = False Then
Sheets("X").Copy After:=Sheets("X")
ActiveSheet.Name = strName
'ActiveSheet.Range("C3") = strName
MsgBox "Kfz erfolgreich eingetragen!"
With Worksheets("DatenKfz")
.Cells(.Cells(.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = strName
End With
Application.DisplayAlerts = True
End If
Sheets("Eintrag").Select
End Sub