sehr schön :-) ....
12.09.2009 11:00:04
Jörg-HH
Moin Ransi
das paßt. Eine Kleinigkeit noch: Statt Exit Sub nach der MsgBox soll wieder zur Inputbox gesprungen werden, um dem User die Möglichkeit zu erneuter Eingabe zu geben. Wie schreibt man das?
Hier der angepaßte Code:
Private Sub Workbook_Open()
Dim i As Integer
Dim MldgFa As String
Dim FileSaveNameAnbieter As Variant
Dim strAnbieterName As Variant
MldgFa = "Bitte geben Sie Ihren Firmennamen in Kurzform ein" & vbLf & _
"z.B. statt Druckerei Meier GmbH & Co. GK einfach: Meier"
If Me.Sheets.Count > 3 Then
Exit Sub 'verhindert, daß msgBox auch bei Mutterdatei _
erscheint
Else
strAnbieterName = Application.InputBox(MldgFa, "Registrierung")
End If
If strAnbieterName = False Then
ThisWorkbook.Close
ElseIf strAnbieterName = "" Then
MsgBox "Ohne Namen kann die Datei nicht verarbeitet werden"
ThisWorkbook.Close
End If
For i = 1 To Len(strAnbieterName)
Select Case Asc(Mid(strAnbieterName, i, 1))
Case 65 To 90, 97 To 122, 196, 214, 220, 223, 228, 246, 252
Case Else:
MsgBox "Einen EINFACHEN Namen bitte! Vermeiden Sie Sonderzeichen usw."
Exit Sub
End Select
Next
MsgBox "Speichern Sie die Datei in einem Ordner Ihrer Wahl." & vbLf & _
"Verändern Sie NICHT den neuen Dateinamen, da sonst" & vbLf & _
"die Rücksendung Ihres Angebots nicht automatisch" & vbLf & _
"eingelesen werden kann und unberücksichtigt bleibt"
FileSaveNameAnbieter = Application.GetSaveAsFilename(InitialFileName:=(Left(ThisWorkbook. _
Name, Len(ThisWorkbook.Name) - 4)) & " " & strAnbieterName, FileFilter:="Microsoft Excel-Arbeitsmappe (*.xls), *.xls", Title:="Dateiname für Ihr Angebot")
If FileSaveNameAnbieter False Then
ActiveWorkbook.SaveAs FileSaveNameAnbieter
Else
Exit Sub
End If
End Sub