Speichern unter "Dateiname - Blattname - Datum"

02/02/2010 - 12:53 von Detlef Rehn | Report spam
Hallo Newsgroup,

ich habe unter Excel 2003 eine Datei mit verschiedenen Kalernderformaten
erstellt. Nun möchte ich auf Knopfdruck einzelne Arbeitsblàtter nach dem
Muster "Dateiname - Arbeitsblattname - Tagesdatum.xls" speichern.
Im Internet habe ich mir auch schon einige Codezeilen zusammengeràubert,
allerdings mit dem unschönen Ergebnis, dass nun als Dateiname

Kalender neu.xls - Quartal - 2010-02-02.xls

angeboten wird. Wie muss ich meinen Code abàndern, damit die ursprüngliche
Dateiendung nicht mehr auftaucht?


'Code in ein Modul (!)
'Danach in das Sheet eine "Schaltfàche" (Button) aus der Formulare Leiste
(!!!)
'einfügen und diesem dieses Makro zuweisen:
Sub SpeicherMirsAlsNeueMappe()
Dim wksA As Worksheet
Dim wbkNeu As Workbook

Dim vntPathAndFile As Variant

Set wksA = ActiveSheet 'Beispiel
vntPathAndFile = Application.GetSaveAsFilename( _
InitialFileName:=ActiveWorkbook.Name & " - " & wksA.Name & " -" &
Format(Now, " yyyy-mm-dd") & ".xls", _
FileFilter:="Excel Files(*.xls), *.xls", _
Title:="Speichern als")

If Not vntPathAndFile = False Then
wksA.Copy
Set wbkNeu = ActiveWorkbook
wbkNeu.SaveAs vntPathAndFile
wbkNeu.Close
End If

End Sub

Vielen Dank für eure Hilfe.
Gruß, Detlef
 

Lesen sie die antworten

#1 Andreas Killer
02/02/2010 - 15:18 | Warnen spam
Detlef Rehn schrieb:

angeboten wird. Wie muss ich meinen Code abàndern, damit die ursprüngliche
Dateiendung nicht mehr auftaucht?


Um eine Extension zu "entfernen" kann man GetBaseName benutzen.

Andreas.

Sub SpeicherMirsAlsNeueMappe()
Dim wksA As Worksheet
Dim wbkNeu As Workbook
Dim vntPathAndFile As Variant

Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")

Set wksA = ActiveSheet 'Beispiel
vntPathAndFile = Application.GetSaveAsFilename( _
InitialFileName:= _
fs.GetBaseName(ActiveWorkbook.Name) & " - " & _
wksA.Name & " - " & _
Format(Now, " yyyy-mm-dd") & ".xls", _
FileFilter:="Excel Files(*.xls), *.xls", _
Title:="Speichern als")

If Not vntPathAndFile = False Then
Set wbkNeu = ActiveWorkbook
wbkNeu.SaveCopyAs vntPathAndFile
wbkNeu.Close
End If
End Sub

Ähnliche fragen