VBA - Speichern unter + Pfad + Dateiendung

Forumthread: VBA - Speichern unter + Pfad + Dateiendung

08.11.2017 15:40:31

Daniel

Hallo,
ich brauche bitte Hilfe.
Da ich mich in VBA nicht so perfekt aufkenne habe ich mir eine Formel zusammenkopiert welche aber leider nicht ganz so funktioniert wie ich das gerne hätte.
Bzw funktioniert eigentlich Tadellos, nur speichert die Datei leider nicht obwohl sogar der Speichern unter Dialog aufgerufen wird wie gewünscht.
Kann mir jemand sagen wieso die Datei nicht gespeichert wird?
Ziel ist einfach die Datei in dem Format .xlsm an dem oben angeführten Pfad speichern bzw. das speichern unter fenster aufzurufen.
Und wenn ich schon dabei bin brauch ich das Makro 1x für Tabellenblat 1 und 1x für Tabellenblatt 1u.2
Danke

Sub Speichern_unter()
Dim Pfad$, Datei$, Filter$, Endg$, File
Pfad = Environ("UserProfile") & "\Oras Group\Projects AUT - Documents\ANGEBOTE\"
Datei = ActiveSheet.Range("Q10")
If Datei = "" Then
MsgBox "Erst Angebotsnummer vergeben!"
Exit Sub
End If
Endg = ".xlsm"
If InStr(Datei, Endg) = 0 Then 'Prüfung ob Zelle bereits Endung enthält
Datei = Datei & Endg
End If
Filter = "Excel Files (*" & Endg & "), *" & Endg
File = Application.GetSaveAsFilename(Pfad & Datei, Filter)
End Sub

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA - Speichern unter + Pfad + Dateiendung

13.11.2017 11:49:55

fcs

AW: VBA - Speichern unter + Pfad + Dateiendung

13.11.2017 11:49:55

fcs

Hallo Daniel,
mit deinem Makro wählst du nur den Dateinamen aus.
Du muss noch die Datei unter dem ausgewählten Namen speichern.
Wenn du einzelne oder mehrere Blätter der Mappe in einer Datei speichern willst, dann musst du das Blatt/die Blätter erst in eine neue Datei kopieren.
Nachfolgend zwei Varianten
A) Auswahl Name unter dem gespeichert werden soll
B) Anzeige des "Speichern unter"-Dialogs
Gruß
Franz

Sub Speichern_unter()
'mit Dateinamen-Auswahl-Dialog
Dim Pfad$, Datei$, Filter$, Endg$, File
Dim wkb As Workbook, wkbNeu As Workbook
Set wkb = ActiveWorkbook
Pfad = Environ("UserProfile") & "\Oras Group\Projects AUT - Documents\ANGEBOTE\"
Pfad = Environ("UserProfile") & "\Documents\Archiv\"
Datei = ActiveSheet.Range("Q10")
If Datei = "" Then
MsgBox "Erst Angebotsnummer vergeben!"
Exit Sub
End If
Endg = ".xlsm"
If InStr(Datei, Endg) = 0 Then 'Prüfung ob Zelle bereits Endung enthält
Datei = Datei & Endg
End If
Filter = "Excel Files (*" & Endg & "), *" & Endg
File = Application.GetSaveAsFilename(Pfad & Datei, Filter)
If File = False Then Exit Sub
wkb.Worksheets(1).Copy 'Statt Indexnummer kann auch der Blattname in _
Anführungszeichen angegeben werden
Set wkbNeu = ActiveWorkbook
wkbNeu.SaveAs Filename:=Replace(File, Endg, "_1" & Endg), FileFormat:=52
wkbNeu.Close savechanges:=False
wkb.Worksheets(Array(1, 2)).Copy 'Statt Indexnummern können auch die Blattnamen in _
Anführungszeichen angegeben werden
Set wkbNeu = ActiveWorkbook
wkbNeu.SaveAs Filename:=Replace(File, Endg, "_1u2" & Endg), FileFormat:=52
wkbNeu.Close savechanges:=False
End Sub
Sub Speichern_unter_Dialog()
'mit Datei-Speichern unter-Dialog
Dim Pfad$, Datei$, Filter$, Endg$, File, varDialog
Dim wkb As Workbook, wkbNeu As Workbook
Set wkb = ActiveWorkbook
Pfad = Environ("UserProfile") & "\Oras Group\Projects AUT - Documents\ANGEBOTE\"
Pfad = Environ("UserProfile") & "\Documents\Archiv\"
Datei = ActiveSheet.Range("Q10")
If Datei = "" Then
MsgBox "Erst Angebotsnummer vergeben!"
Exit Sub
End If
Endg = ".xlsm"
If InStr(Datei, Endg) = 0 Then 'Prüfung ob Zelle bereits Endung enthält
Datei = Datei & Endg
End If
File = Pfad & Datei
wkb.Worksheets(1).Copy 'Statt Indexnummer kann auch der Blattname in _
Anführungszeichen angegeben werden
Set wkbNeu = ActiveWorkbook
varDialog = Application.Dialogs(xlDialogSaveAs).Show( _
Replace(File, Endg, "_1" & Endg), 52)
wkbNeu.Close savechanges:=False
wkb.Worksheets(Array(1, 2)).Copy 'Statt Indexnummern können auch die Blattnamen in _
Anführungszeichen angegeben werden
Set wkbNeu = ActiveWorkbook
varDialog = Application.Dialogs(xlDialogSaveAs).Show( _
Replace(File, Endg, "_1u2" & Endg), 52)
wkbNeu.Close savechanges:=False
End Sub

Infobox / Tutorial

VBA: Speichern unter mit Pfad und Dateiendung

Schritt-für-Schritt-Anleitung
Häufige Fehler und Lösungen
Alternative Methoden
Praktische Beispiele
Tipps für Profis
FAQ: Häufige Fragen

Schritt-für-Schritt-Anleitung

Um eine Excel-Datei mit VBA unter einem spezifischen Pfad und mit einer vorgegebenen Dateiendung zu speichern, kannst du folgendes Makro verwenden:

Sub Speichern_unter()
    Dim Pfad As String, Datei As String, Filter As String, Endg As String, File As Variant
    Pfad = Environ("UserProfile") & "\Oras Group\Projects AUT - Documents\ANGEBOTE\"
    Datei = ActiveSheet.Range("Q10").Value

    If Datei = "" Then
        MsgBox "Erst Angebotsnummer vergeben!"
        Exit Sub
    End If

    Endg = ".xlsm"
    If InStr(Datei, Endg) = 0 Then
        Datei = Datei & Endg
    End If

    Filter = "Excel Files (*" & Endg & "), *" & Endg
    File = Application.GetSaveAsFilename(Pfad & Datei, Filter)

    If File = False Then Exit Sub

    ActiveWorkbook.SaveAs Filename:=File, FileFormat:=52
End Sub

Dieses Makro verwendet den %userprofile%-Pfad und ermöglicht es dir, eine Datei mit der Endung .xlsm zu speichern. Stelle sicher, dass der Bereich Q10 auf deinem Arbeitsblatt den gewünschten Dateinamen enthält.

Häufige Fehler und Lösungen

Fehler: Datei wird nicht gespeichert.
Lösung: Überprüfe, ob der Pfad korrekt ist und die Datei nicht bereits geöffnet ist. Achte darauf, dass der Dateiname in Zelle Q10 angegeben ist.
Fehler: Der Speichern-unter-Dialog wird nicht angezeigt.
Lösung: Stelle sicher, dass der Application.GetSaveAsFilename Befehl korrekt implementiert ist und nicht durch einen vorhergehenden Exit-Befehl unterbrochen wird.

Alternative Methoden

Wenn du unterschiedliche Blätter in einer neuen Datei speichern möchtest, kannst du das folgende Makro verwenden:

Sub Speichern_unter_Mehrere_Blaetter()
    Dim wkb As Workbook, wkbNeu As Workbook
    Set wkb = ActiveWorkbook

    wkb.Worksheets(1).Copy
    Set wkbNeu = ActiveWorkbook
    wkbNeu.SaveAs Filename:=Environ("UserProfile") & "\Documents\Archiv\" & "Neuer_Dateiname.xlsm", FileFormat:=52
    wkbNeu.Close savechanges:=False
End Sub

Mit dieser Methode kannst du auch mehrere Blätter in einer neuen Datei speichern, indem du die gewünschte Anzahl an Blättern kopierst.

Praktische Beispiele

Hier ist ein praktisches Beispiel, um eine Datei mit dem Namen "Angebot.xlsx" im gewünschten Pfad zu speichern:

Trage in Zelle Q10 den Text „Angebot“ ein.
Führe das Makro Speichern_unter() aus.
Der Speichern-unter-Dialog öffnet sich und du kannst die Datei im angegebenen Pfad speichern.

Tipps für Profis

Verwende Fehlerbehandlung: Ergänze dein Makro mit On Error Resume Next, um potenzielle Fehler abzufangen.
Automatisierung: Du kannst das Speichern unter mit anderen VBA-Prozessen kombinieren, um den Workflow zu optimieren.
Benutzerdefinierte Dialoge: Erstelle eigene Dialoge für eine benutzerfreundlichere Erfahrung beim Speichern unter.

FAQ: Häufige Fragen

1. Wie kann ich den Pfad dynamisch ändern?
Du kannst den Pfad in der Variablen Pfad anpassen, um ihn an deine Bedürfnisse anzupassen.

2. Was passiert, wenn ich die Datei unter einem Namen speichere, der bereits existiert?
Wenn du eine Datei speicherst, die bereits existiert, wird Excel dich fragen, ob du die Datei überschreiben möchtest. Achte darauf, dass du dies in deinem Makro berücksichtigst.

3. Welche Excel-Version ist erforderlich?
Die genannten Makros sind mit Excel 2010 und höher kompatibel.

Beliebteste Forumthreads (12 Monate)

VBA - Speichern unter + Pfad + Dateiendung

Forumthread: VBA - Speichern unter + Pfad + Dateiendung

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

VBA: Speichern unter mit Pfad und Dateiendung

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread