dateinamen aus Zelle übernehmen
Friedemann
ich versuche die ganze Zeit mit folgendem Code der Datei beim klicken auf das Speichersymbol den Wert in Zelle S1 als Dateinamen zuzuweisen.
Ich habe den Code in "DieseArbeitsmappe"
Leider funktieoniert es immer nur einmal. Wenn ich die Datei erneut aufrufe oder den wert in Zelle S1 erneut ändere, Läuft das Makro nicht erneut ab.
Wo liegt der Fehler? Kann mir da jemand helfen?
Hier der verwendete Code
Private Sub SpeichernUnter()
Dim fn As String
'Dateiname ermitteln und prüfen:
fn = Worksheets("Daily-Report").Range("S1")
If Trim(fn) = "" Or _
InStr(fn, ".") > 0 Or _
InStr(fn, "\") > 0 Or _
InStr(fn, "/") > 0 Or _
InStr(fn, " 0 Or _
InStr(fn, ">") > 0 Or _
InStr(fn, "[") > 0 Or _
InStr(fn, "]") > 0 Or _
InStr(fn, ":") > 0 Or _
InStr(fn, "|") > 0 Or _
InStr(fn, "*") > 0 Or _
InStr(fn, "?") > 0 Then
MsgBox "Unzulässiger Dateiname!" & vbLf & "Datei wurde nicht gespeichert!", vbCritical
Exit Sub
End If
Application.EnableEvents = False
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & fn & ".xls"
If Err.Number > 0 Then MsgBox Err.Description, vbCritical, "Fehler " & Err.Number
On Error GoTo 0
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Danke vorab,
Friedemann