Registriert seit: 16.04.2014
Hallo VBA-Freunde,
Ich möchte eine Datei per VBA speichern und dabei die Dialogbox "Speichern unter" verwenden.
Mein Codeschnipsel
Pfad = "G:\"
Application.Dialogs(xlDialogSaveAs).Show Pfad & Sname
funktioniert. Nur möchte ich gerne den Dateityp XLSM gleich vorgeben.
Wie müsste das erweitert werden?
Ach so, Für Excel 2010 und höher.
Vielen Dank für eure Antworten.
Heinz
Es ist nicht genug, zu wissen. Man muss es auch anwenden.
Es ist nicht genug, zu wollen. Man muss es auch tun.
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Heinz,
Application.Dialogs(xlDialogSaveAs).Show Pfad & Sname, 52
Gruß Uwe
Registriert seit: 10.04.2014
Version(en): 2016 + 365
19.04.2017, 08:55
(Dieser Beitrag wurde zuletzt bearbeitet: 19.04.2017, 08:55 von Rabe.)
Hi Heinz,
(19.04.2017, 08:07)Heinz Ulm schrieb: Pfad = "G:\"
Application.Dialogs(xlDialogSaveAs).Show Pfad & Sname
funktioniert. Nur möchte ich gerne den Dateityp XLSM gleich vorgeben.
ich habe diverse Schnipsel zum testen:
ActiveWorkbook.SaveAs strSaveDatei, FileFormat:=xlOpenXMLWorkbook
oder
Code:
Function SpeichernUnter(VorgabeName As String) As String
' Dialog Aufrufen um den Speicherort zu bestätigen oder einen anderen Speicherort anzugeben und zu bestätigen
'Kann auch abgebrochen werden. dann ist der Rückgabewert ein "Falsch", sonst der Pfad und Dateiname
SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Excel Dateien (*.xlsm),*.xlsm*", FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")
'strSaveDatei = SpeichernUnter
End Function
entnommen von hier:
Speichern unterCode:
Sub Speichern_unter1()
Dim strDateiName As String
Dim strVerzeichnisPfad As String
Dim strSaveDatei As String
Dim bSpeichernDialog As Boolean
Dim bSpeichern As Boolean
bSpeichern = False
'Wert True = es wird defintiv gespeichert. False = nichts Speichern
'------------------------------------------------------------------------
'Festlegen ob der Speichern unter Dialog (GetSaveAsFileName) überhaupt aufgerufen werden soll
'Wert auf False setzen wenn dies nicht gewünscht wird. Kann auch durch eine Zellabfrage (0 oder 1) erfolgen
'dann bSpeichernDialog = Range("X1") wobei eine 0 Falsch und alles andere Wahr bedeutet. Ansonsten hier Manuell festlegen
bSpeichernDialog = Range("X1")
'bSpeichernDialog = False
'------------------------------------------------------------------------
'Verzeichnispfad Vorschlag festlegen
strVerzeichnisPfad = "c:\temp\"
'Dateiname aus Zelle F4 des aktuellen Blatts holen und Datum (Sortierbar) und Dateierweiterung dranhängen. Die yyymmdd ist bei sortierung richtig
strDateiName = Range("F4") & Format(Date, "_yyyymmdd") & ".xlsm"
'Speicherpfad und Dateiname zusammenfügen
strSaveDatei = strVerzeichnisPfad & strDateiName
'------------------------------------------------------------------------
'Mit dem jetzt vorhandenen Dateiname inkl. Pfad abfragen ob der Speicherort OK ist.
'Dazu das Dialogfenster GetSaveAsFilename aufrufen (Achtung, mus Zwingend Bestätigt werden
'Dies aber nur falls der Dialog abgefragt werden soll. bSpeicherDialog regelt dies über Wahr / Unwahr
If bSpeichernDialog Then
'Dialog zum bestätigen des Speicherorts und Datename aufrufen. Achtung, kann auch mit Abbrechen beendet werden
'Zuweisen des endgültigen Dateinamens oder ein Falsch wenn abbruch
strSaveDatei = SpeichernUnter(strSaveDatei)
'Wurde abgebrochen?
If strSaveDatei = "Falsch" Then
'Es wurde im Speicherdialog auf Abbrechen geklickt. Nichts zu tun und Tschüß
bSpeichern = False
'Exit Sub
'Mit Exit Sub kann hier die gesamte restliche SUB beendet werden. Unschön, aber manchmal nötig
Else
'Im Dialog wurde auf Speichern geklickt
bSpeichern = True
End If
Else
'Der Dialog sollte nicht aufgerufen werden, also wird der DateiPfad und Name als gegeben und nicht änderbar angenommen.
bSpeichern = True
End If
'------------------------------------------------------------------------
'Bestimmen ob dies eine Neue datei oder eine schon vorhandene ist.
'Falls neu, das .SaveAs verwenden. Wen die Datei schon vorhanden ist, wird zwingend ein Dialog wegen überschreibung eingeblendet
'daher falls die Datei schon vorhanden ist, das .Save verwenden was einen Überschreiben Dialog nicht aufruft
Do While bSpeichern
If DateiVorhanden(strSaveDatei) Then
'Datei wird überschrieben OHNE Dialog
ActiveWorkbook.Save
Else
'Datei wird erstmalig erstellt Ohne Dialog
ActiveWorkbook.SaveAs strSaveDatei
End If
bSpeichern = False
Loop
End Sub
Function SpeichernUnter(VorgabeName As String) As String
' Dialog Aufrufen um den Speicherort zu bestätigen oder einen anderen Speicherort anzugeben und zu bestätigen
'Kann auch abgebrochen werden. dann ist der Rückgabewert ein "Falsch", sonst der Pfad und Dateiname
SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Filefilter:="Excel Dateien (*.xlsm),*.xlsm*", FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")
'strSaveDatei = SpeichernUnter
End Function
Function DateiVorhanden(DateipfadName As String) As Boolean
'Über die Dir Funktion schauen ob die Datei existirt. Wenn ja, wird der dateiname zurückgegeben, sonst ein null String
'Mit dem vergleich > wird geschaut ob etwas zurück kam. Ergebniss ist True oder False
DateiVorhanden = (Dir(DateipfadName) > "")
End Function
Registriert seit: 16.04.2014
Hallo Uwe,
hallo Ralf,
vielen Dank für eure Lösungen.
Faulheit siegt, deshalb habe ich mich für Uwe's Rat mit ,52 entschieden und getestet.
Es läuft so wie ich es wollte.
Danke
Viele Grüße
Heinz
Es ist nicht genug, zu wissen. Man muss es auch anwenden.
Es ist nicht genug, zu wollen. Man muss es auch tun.
Registriert seit: 10.04.2014
Version(en): 2016 + 365
Hi Heinz,
(19.04.2017, 09:12)Heinz Ulm schrieb: Faulheit siegt, deshalb habe ich mich für Uwe's Rat mit ,52 entschieden und getestet.
klar, hätte ich auch so gemacht.
Das andere ist halt für später nachvollziehbarer.
Hier die FileFormat-Nummern:
Zitat:These are the main file formats in Excel 2007-2016,
Note: In Excel for the Mac the values are +1
51 = xlOpenXMLWorkbook (without macro's in 2007-2016, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2016, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007-2016 with or without macro's, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007-2016, xls)