[Excel] Dateinamen automatisch durch eine Zelle

[undertaker1988]

Hallo miteinander,

hab da mal wieder eine Frage zum wunderbaren Programm Excel.

Situation:

Ich schreibe in Excel einen Brief mit verschiedenen Inhalten, wie Name, Datum und einer individuellen Nummer.

Alle Angaben stehen auf meinen Excelarbeitsblatt.

ZelleB4: "Datum"
ZelleD4: "Name"
ZelleE5: "Nummer"

Problem:

Ich möchte gerne das Excel automatisch den Dateinamen beim speichern auswählt.
Der sollte dann folgender maßen lauten.

Datum_Name_Nummer

Lösung:

Dafür danke ich euch bereits im Voraus.

Gruß

Flo

 

[1668mib]

Könnte sich vielleicht mit VBA realisieren lassen, leider hab ich da schon länger nichts miehr mit gemacht...

 

[Mr. Snoot]

Falls du dich etwas mit VBA auskennst hier ein Script zum Speichern. Der Dateiname wird bei sDatum und sSaveName vergeben. Das müsstest du halt etwas modifizieren. Für deine Zellenangaben mit Range("B4"), Range("D4") und Range("E5"):

Attribute VB_Name = "Speichern"
[COLOR="green"]'************************************'
'Makro um neue Losliste zu speichern '
'************************************'[/COLOR]

Sub DateiSpeichern()

Dim sBlatt As String
Dim sLwBuchstb As String
Dim sPfad As String
Dim sDatum As String
Dim sSaveName As String
sBlatt = "Alle Lose"

[COLOR="green"]'*********************************************************************'
' Pfad der aktuellen Losliste ermitteln und zum Speichern vorschlagen '
'*********************************************************************'[/COLOR]
sLwBuchstb = Left(ThisWorkbook.Path, 1)   [COLOR="Green"]' Pfad ermitteln und alles bis auf 1. Buchstaben (= Laufwerksbuchstabe) abschneiden[/COLOR]
sPfad = ThisWorkbook.Path
ChDrive sLwBuchstb                        [COLOR="green"]' Wechselt auf das Laufwerk, auf dem sich diese Datei befindet[/COLOR]
ChDir sPfad                               [COLOR="green"]' Wechselt in das Verzeichnis dieser Datei[/COLOR]

neu_speichern:                            [COLOR="green"]' Sprungmarke, falls falsches Dateiformat angegeben wurde[/COLOR]
[COLOR="red"]sDatum = Format(Now(), "yyyymmdd")[/COLOR]        [COLOR="seagreen"]' Aktuelles Datum formatieren für Dateinamen: yyyymmdd[/COLOR]
[COLOR="red"]sSaveName = sDatum & "_project_lots.xlsm"[/COLOR]
dateiname = Application.GetSaveAsFilename(sSaveName, "Microsoft Excel 2007 mit Makros (*.xlsm),*.xlsm,Microsoft Excel 2007 ohne Makros (*.xlsx),*.xlsx,Microsoft Excel 97-2003 mit Makros (*.xls),*.xls,Textdatei (Tabstopp-getrennt) (*.txt),*.txt", , _
  "Losliste speichern unter") [COLOR="Green"]' die Zeile dateiname nicht umbrechen[/COLOR]

[COLOR="green"]'********************'
' Dateiendung prüfen '
'********************'[/COLOR]
If dateiname = False Then Exit Sub        [COLOR="green"]' Makro beenden wenn Speichervorgang abgebrochen wird[/COLOR]
  If Right(dateiname, 4) = ".xls" Then
    ActiveWorkbook.SaveAs (dateiname), FileFormat:=xlNormal
  ElseIf Right(dateiname, 4) = ".txt" Then
    ActiveWorkbook.SaveAs (dateiname), FileFormat:=xlText
  ElseIf Right(dateiname, 5) = ".xlsm" Then
    ActiveWorkbook.SaveAs (dateiname), FileFormat:=xlOpenXMLWorkbookMacroEnabled
  ElseIf Right(dateiname, 5) = ".xlsx" Then [COLOR="Green"]' Buttons usw. löschen wenn die Datei ohne Makros gespeichert wird, da dann unnötig[/COLOR]
    Application.DisplayAlerts = False       [COLOR="green"]' Fehlermeldung deaktivieren um Tabellenblatt löschen zu können[/COLOR]
    Worksheets("Link").Delete
    With Worksheets(sBlatt)
      .Buttons("Comments").Delete
      .Buttons("Speichern").Delete
    End With
    ActiveWorkbook.SaveAs (dateiname), FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
  Else
    MsgBox "Fehlerhaftes Dateiformat. Mögliche Formate:" _
    & Chr(13) & Chr(13) & "            *.xls, *.xlsx, *.xlsm, *.txt", , "Fehler beim Speichern"
    GoTo neu_speichern        [COLOR="green"]' Beginnt Speichervorgang von vorne[/COLOR]
  End If

End Sub