25.07.2019, 11:04
Hallo,
ich möchte gerne den Inhalt einer Zelle als Dateiname automatisch generieren möglichst noch mit Pfadangabe wo diese gespeichert werden soll.
Gefunden habe ich
Private Sub SpeichernUnter()
Dim fn As String
'Dateiname ermitteln und prüfen:
fn = Worksheets("Kalkulation").Range("B2")
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 & ".xlm"
If Err.Number > 0 Then MsgBox Err.Description, vbCritical, "Fehler " & Err.Number
On Error GoTo 0
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Leider funzt hier bei klick auf speichern unter nix - Dateiname ist immer noch der Urspungsname
Excel 2016 habe ich im Einsatz - der Code ist wohl aus 2007.
ich möchte gerne den Inhalt einer Zelle als Dateiname automatisch generieren möglichst noch mit Pfadangabe wo diese gespeichert werden soll.
Gefunden habe ich
Private Sub SpeichernUnter()
Dim fn As String
'Dateiname ermitteln und prüfen:
fn = Worksheets("Kalkulation").Range("B2")
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 & ".xlm"
If Err.Number > 0 Then MsgBox Err.Description, vbCritical, "Fehler " & Err.Number
On Error GoTo 0
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Leider funzt hier bei klick auf speichern unter nix - Dateiname ist immer noch der Urspungsname
Excel 2016 habe ich im Einsatz - der Code ist wohl aus 2007.