Excel-Datei mit VBA speichern

Guten Tag

Ich habe eine Excel-Datei, in der in D4 der Kundenname und in D11 das Projekt benennt wird.

Icvh will nun wissen, ob eine Speicherung der Datei über die Felder D4 und D11 möglich ist, bzw. die Datei sollte z.B. unter Musterfirma AG, Testprojet abgespeichert werden, wobei Musterfirma in der Zelle D4 und Testprojekt in der Zelle D11 ist.

Ich danke im Voraus für Eure Hilfe.

Gruss
dawatec

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 242823

Url: https://administrator.de/forum/excel-datei-mit-vba-speichern-242823.html

Ausgedruckt am: 25.04.2025 um 12:04 Uhr

6 Kommentare

Neuester Kommentar

Hallo dawatec,
kein Problem; es kommt hier drauf an ob du das Dokument als extra Kopie abspeichern willst ohne das es zum aktuellen wird, oder ob du das aktive Dokument unter einem anderen Namen speichern willst: Habe dazu zwei Subs in den Code reingepackt (Pfade und entsprechende Worksheets sind natürlich anzupassen)

Sub KopieSpeichern()
    kunde = ReplaceIllegalChars(Worksheets(1).Range("D4").Value)  
    projekt = ReplaceIllegalChars(Worksheets(1).Range("D11").Value)  
    If kunde <> "" And projekt <> "" Then  
        dateiname = "C:\Pfad\" & kunde & ", " & projekt & ".xlsx"  
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveCopyAs dateiname
        Application.DisplayAlerts = True
    Else
        MsgBox "Kunde oder Projekt wurde nicht eingetragen!", vbExclamation  
    End If
End Sub

Sub Speichern()
    kunde = ReplaceIllegalChars(Worksheets(1).Range("D4").Value)  
    projekt = ReplaceIllegalChars(Worksheets(1).Range("D11").Value)  
    If kunde <> "" And projekt <> "" Then  
        dateiname = "C:\Pfad\" & kunde & ", " & projekt & ".xlsx"  
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs dateiname, xlOpenXMLWorkbook
        Application.DisplayAlerts = True
    Else
        MsgBox "Kunde oder Projekt wurde nicht eingetragen!", vbExclamation  
    End If
End Sub

' Ersetzt Illegale Sonderzeichen im Dateinamen durch einen Unterstrich  
Function ReplaceIllegalChars(strText As String)
    Set regex = CreateObject("vbscript.regexp")  
    regex.Pattern = "[\\/:\?<>|""*]"  
    regex.Global = True
    ReplaceIllegalChars = regex.Replace(strText, "_")  
    Set regex = Nothing
End Function

Es gilt hierbei zu beachten das wenn du das Dokument welches die Makros enthält alternativ als xlsx abspeichern möchtest der Methode SaveAs noch das entsprechende Format im zweiten Parameter mit übergeben werden muss z.B. ActiveWorkbook.SaveAs dateiname, xlOpenXMLWorkbook, sonst läuft die Methode auf einen Laufzeitfehler, weil ja im Dokument Makros enthalten sind und diese in einem xlsx nicht gespeichert werden können.

Grüße Uwe

Hallo Uwe

Vielen Dank für Deine Hilfe.

Ich sende die Datei dem Kunden zum Ausfüllen und er schickt mir diese wieder ausgefüllt zurück. Ich weiss also nicht, ob und wo er sich die Datei abspeichert und vorgeben kann ich ihm dies natürlich nicht.

Der Code wird so nicht funktionieren, stimmt meine Aussage?

Liebe Grüsse
dawatec

Der Code wird so nicht funktionieren, stimmt meine Aussage?

Generell stimmt sie nicht, funktionieren tut er, die Frage ist eher was du genau vorhast !
Spezifiziere deine Wünsche bitte exakter !!! Ich kann ja nicht Hellsehen.
Wer soll hier wo abspeichern ?

Ich sende die Datei dem Kunden zum Ausfüllen und er schickt mir diese wieder ausgefüllt zurück

Ich würde hierfür in das Dokument einen Button setzen der das File direkt als Attachment an eine Mail anhängt. So muss der Kunde keinen Umweg über das Dateisystem machen.

Um das ganze abzukürzen kannst du mir dein File auch zusenden, dann bau ich dir die Funktion ein, meine Mailadresse solltest du ja noch haben.

Grüße Uwe

Hallo Uwe

Du hast Recht, das ist kein mach-mir-die-Arbeit Wuschkonzert, das sehe ich auch so und war auch nicht die Meinung. Nur, ich denke mir, dass in Foren wie in diesem einem geholfen werden sollte, sonst macht es ja keinen Sinn.

Nochmals zu meiner Aufgabe:

Nach nochmaliger Ansicht meiner ersten Anfrage muss ich Dir ebenfalls Recht geben, die Anfrage war unvollständig definiert...., sorry.

Ich habe ein Abfrage-Excel-Sheet, welches ich den Kunden per Mail zustelle, damit sie die Angaben zur Erstellung eines Angebotes machen können. Da nicht alle die Datei richtig abspeichern und ich dies auch nicht vorschreiben will und kann will, war meine Idee, nach eine VBA-Lösung zu fragen, damit die Kunden bereits einen Speichernamen vorgeschlagen haben, die sie übernehmen können.

Da ich kein VBA-Experte bin, muss ich mir bei der Lösung helfen lassen......

Ich habe aber keine Ahnung, ob der Kunde das Sheet abspeichert oder eine direkte Eingabe macht und genau da ist der Haken.....

Ich würde mich trotzdem freuen, wenn Du mich im positiven Sinne unterstützen kannst. In PDF bringt die ganze Sache nichts, der Kunde kann das Sheet nicht ausfüllen und schon gar nicht abspeichern, denn die prof-Version ist nicht sehr verbreitet,

Gruss
dawatec

Zitat von @116408:
Ich habe aber keine Ahnung, ob der Kunde das Sheet abspeichert oder eine direkte Eingabe macht und genau da ist der Haken.....

Siehe unten.

In PDF bringt die ganze Sache nichts, der Kunde kann das Sheet nicht ausfüllen und schon gar nicht abspeichern,

sicher geht das, Ausfüllen kann er immer und auch abspeichern geht mit dem normalen Reader !!!! Nur zum Erstellen des Formulars benötigt man die Prof. Version, glaub's mir.

Wichtige Info zu VBA-Code in Dateien die du Kunden schickst:
Die Ausführung von VBA-Code ist in Office standardmäßig deaktiviert! Es wird also dort in wahrer Voraussicht zu häufigen Nachfragen kommen, weil etwas nicht so funktioniert wie es soll, deswegen bist du mit PDF-Formularen hier auf einer sichereren Seite. Das haben diverse Anfragen von Kunden bei mir gezeigt, die eine ähnliche Funktion implementiert haben wollten.

Wenn du es warum auch immer so lösen willst, bitte:
Kommentare befinden sich im Code, deine Mailadresse in Zeile 35 anpassen.
Hier auch die Demo-Datei dazu.

Sub SaveAndSend()
    Dim dlg As FileDialog, kunde As String, projekt As String, dateiname As String, strEmail As String
    
    'Felder aus denen der Dateiname zusammengesetzt werden soll  
    kunde = ReplaceIllegalChars(Worksheets(1).Range("D4").Value)  
    projekt = ReplaceIllegalChars(Worksheets(1).Range("D11").Value)  
    
    ' Wenn beide Felder nicht leer sind setze den Dateinamen  
    If kunde <> "" And projekt <> "" Then  
        dateiname = strTempFolder & kunde & "_" & projekt & ".xlsx"  
    Else ' eins der beiden Felder ist leer, verwende den aktuellen Dateinamen  
        dateiname = ActiveWorkbook.Name
    End If
    
    Set dlg = Application.FileDialog(msoFileDialogSaveAs)
    With dlg
        'Initialen Dateinamen festlegen  
        .InitialFileName = dateiname
        ' Wähle den richtigen Dateifilter  
        For i = 1 To .Filters.Count
            If .Filters(i).Extensions = "*.xlsx" Then  
                .FilterIndex = i
                Exit For
            End If
        Next
        'Wenn OK geklickt wurde starte Export  
        If .Show = True Then
            Application.DisplayAlerts = False
            'Speichern durchführen  
            .Execute
            Application.DisplayAlerts = True
            ' Frage ob das Workbook per Mail verschickt werden soll  
            If MsgBox("Möchten Sie das Dokument jetzt mit ihrem Standard E-Mailprogramm verschicken ?", vbYesNo Or vbQuestion) = vbYes Then  
                ' Hier bitte die Mailadresse anpassen  
                strEmail = "deine@mail.de"  
                ' Mail senden  
                ActiveWorkbook.SendMail strEmail
            End If
        End If
    End With
End Sub

Function ReplaceIllegalChars(strText As String)
    Set regex = CreateObject("vbscript.regexp")  
    regex.Pattern = "[\\/:?<>|""*]"  
    regex.Global = True
    ReplaceIllegalChars = regex.Replace(strText, "_")  
    Set regex = Nothing
End Function

Viel Erfolg
Grüße Uwe

Hallo Uwe

Ich danke Dir für Dein Verständnis und Deine grossartige Hilfe.

Ich werde Deine Arbeit morgen in die Datei einfliessen lassen.

Liebe Grüsse
dawatec

gelöstFrage Microsoft

Heiß diskutiert