armin-k
Goto Top

Excel 2010 Speichern unter Dialog ohne Bestätigung

Liebe Forengemeinde,
vielleicht kann jemand helfen? Ich habe in einer Excel-Datei ein Makro/Funktion zum eigenständigen Speichern der Datei nach bestimmten Zellangaben. Das funktioniert grundsätzlich auch. Es wird beim Aufruf des Speichern Dialogs aber immer eine Bestätigungsabfrage eingeblendet (die noch mit OK bestätigt werden muss), kann man das evtl. überbrücken. Möglicherweise bereits vorhandene Dateien könnten überschrieben werden "nach Möglichkeit ohne weitere Abfrage, vielleicht Hinweis ?? ")

Sub Speichern_unter1()

Dim Datei As String
Dim Verzeichnis As String
Dim SaveDummy As Variant

Verzeichnis = "d:\temp\" 'Verzeichnis-Vorschlag
Datei = Range("F4") & Format(Date, "_dd_mm_yy") & ".xlsm" 'Datei-Vorschlag
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy <> False Then ActiveWorkbook.SaveAs SaveDummy 'Es wurde im Dialog auf Speichern gedrückt

End Sub


Function SpeichernUnter(VorgabeName As String) As Variant
SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Filefilter:="Excel Dateien (*.xlsm),*.xlsm*", _
FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")
End Function

Content-Key: 191283

Url: https://administrator.de/contentid/191283

Ausgedruckt am: 28.03.2024 um 12:03 Uhr

Mitglied: Pjordorf
Pjordorf 15.09.2012 aktualisiert um 14:35:55 Uhr
Goto Top
Hallo,

Zitat von @Armin-K:
nach Möglichkeit ohne weitere Abfrage, vielleicht Hinweis ??
Und mit code tags sieht es noch besser ausface-smile Formatierungen in den Beiträgen

Das geht schon. Mit DisplayAlerts = False kannst du diesen Dialog unterdrücken, aber das kann auch daneben gehen. Ist die existierende Datei schon durch jemand anderes ebenfalls geöffnet, wird dir ein Laufzeitfehler gemeldet. Einfache Variante:
    If SaveDummy <> False Then 
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs SaveDummy 'Es wurde im Dialog auf Speichern gedrückt  
        Application.DisplayAlerts = True
    End If

Etwas aufwändiger face-smile aber dafür besser ist es vor dem Speichern zu prüfen ob die Datei schon existiert und wenn ja das .Save verwenden was ja automatisch überschreibt.
    If DateiVorhanden(SaveDummy) Then
            ActiveWorkbook.Save
        Else
            ActiveWorkbook.SaveAs SaveDummy 'Es wurde im Dialog auf Speichern gedrückt  
        End If
    End If

Function DateiVorhanden(DateipfadName As Variant) As Boolean
' Dir liefert den Pfad und Dateiname wenn vorhanden, ansonsten wird ein leerer String zurückgegeben.  

    DateiVorhanden = (Dir(DateipfadName) > "")  

End Function

Warum hast du dein SaveDummy als Variant definiert? Ein "Dim SaveDummy as String" reicht doch vollkommen.

Gruß,
Peter
Mitglied: Armin-K
Armin-K 15.09.2012 um 15:18:58 Uhr
Goto Top
Hallo Peter,

vielen Dank für Deine schnelle und liebe Antwort. Ich bin doch noch auf der Suche nach "KnowHow" in den Tiefen des VBA-Universums und scheitere deshalb auch schnell. Den Code habe ich mir nicht selbst einfallen lassen - sondern in Zügen abgekupfert.
Leider komme ich nicht weiter, vielleicht ahbe ich mich aber auch nicht richtig erklärt. Beim Aufruf des Makro soll die Datei als neue Datei gespeichert und geschlossen werden. Eine Bestätigungsabfrage "Speichern" soll nicht mehr gestellt werden.

Ich habe hier noch mal den VBA-Text, die Datei stelle ich auch gern per Mail zur Verfügung...


Sub Speichern_unter1()

Dim Datei As String
Dim Verzeichnis As String
Dim SaveDummy As Variant

Verzeichnis = "d:\temp\" 'Verzeichnis-Vorschlag
Datei = Range("F4") & Format(Date, "_dd_mm_yy") & ".xlsm" 'Datei-Vorschlag
SaveDummy = SpeichernUnter(Verzeichnis & Datei)

If DateiVorhanden(SaveDummy) Then
ActiveWorkbook.Save
Else
ActiveWorkbook.SaveAs SaveDummy 'Es wurde im Dialog auf Speichern gedrückt
End If


End Sub

Function SpeichernUnter(VorgabeName As String) As Variant
SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Filefilter:="Excel Dateien (*.xlsm),*.xlsm*", _
FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")

End Function

Function DateiVorhanden(DateipfadName As Variant) As Boolean
' Dir liefert den Pfad und Dateiname wenn vorhanden, ansonsten wird ein leerer String zurückgegeben.

DateiVorhanden = (Dir(DateipfadName) > "")

End Function
Mitglied: Pjordorf
Pjordorf 15.09.2012 aktualisiert um 16:12:58 Uhr
Goto Top
Hallo Armin-K,

Zitat von @Armin-K:
Ich habe hier noch mal den VBA-Text
Ohne das dieser in code tags (zum 2ten) hier rein gestellt wurde schaue ich mir den nicht an und antworte auch nicht weiter. Mach es uns doch nicht schwerer als nötig. Ich nemhe mir doch auch Zeit dein Problem zu verstehen und dir eine Lösung bzw. Lösungsansätze bieten zu können und das in einer Form das alle es verstehen können. Dazu gehört es nunmal Code in entsprechende Tags einzubetten. Auch ich habe mir mal Zeit genommen die Forenregeln durchgelesen. :'(

Gruß,
Peter
Mitglied: Armin-K
Armin-K 15.09.2012 um 16:46:04 Uhr
Goto Top
Hallo Peter,

Du wirst sicher gesehen haben, dass ich neu bin. Die Formatierungsdefizite waren keine Schikane, ich hatte Schwierigkeiten das entsprechend umzusetzen. Ich hoffe es funktioniert so....?

Also noch mal sorry, aber ich habe mir wirklich Mühe gegeben!

LG
Mitglied: Armin-K
Armin-K 15.09.2012 um 16:47:34 Uhr
Goto Top
Sub Speichern_unter1()
 
Dim Datei As String
 Dim Verzeichnis As String
 Dim SaveDummy As Variant
 
Verzeichnis = "d:\temp\" 'Verzeichnis-Vorschlag  
 Datei = Range("F4") & Format(Date, "_dd_mm_yy") & ".xlsm" 'Datei-Vorschlag  
 SaveDummy = SpeichernUnter(Verzeichnis & Datei)

 If DateiVorhanden(SaveDummy) Then
 ActiveWorkbook.Save
 Else
 ActiveWorkbook.SaveAs SaveDummy 'Es wurde im Dialog auf Speichern gedrückt  
 End If

 
End Sub
 
Function SpeichernUnter(VorgabeName As String) As Variant
 SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Filefilter:="Excel Dateien (*.xlsm),*.xlsm*", _  
 FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")  

 End Function
 
Function DateiVorhanden(DateipfadName As Variant) As Boolean
 ' Dir liefert den Pfad und Dateiname wenn vorhanden, ansonsten wird ein leerer String zurückgegeben.  
 
DateiVorhanden = (Dir(DateipfadName) > "")  
 
End Function
Mitglied: Pjordorf
Pjordorf 15.09.2012 um 17:18:41 Uhr
Goto Top
Hallo Armin-K,

Zitat von @Armin-K:
Du wirst sicher gesehen haben, dass ich neu bin.
Nein, ich muss allerdings gestehen das ich mir dein prifil vorher auch nicht angeschaut habe. Das habe ich aber jetzt nachgeholt und reiche dir unser "Hallo und willkomen hier Forum" jetzt nachface-smile

Die Formatierungsdefizite waren keine Schikane
Naja, eine Schikane ist doch gaaaanz was anderes, oder? Sehe ich im F1 Zirkus immerface-smile

ich hatte Schwierigkeiten das entsprechend umzusetzen.
Dann einfach fragen wie andere es gemacht haben (dann aber bitte gezielte Fragen)face-smile

Ich hoffe es funktioniert so....?
Ja, hat. Du kannst aber auch anstatt den ganzen Quellcode hier erneut (in einer neuen Antwort) rein zu stellen, einfach auf deine Frage / Antworten gehen und dann auf Bearbeiten Klicken und dort auch nachträglich änderungen vornehmen und diese evtl. auch als solche kennzeichnen z.B. mit "Nachtrag" oder [Edit] oder [/Geändert] oder was auch immerface-smile

Also noch mal sorry, aber ich habe mir wirklich Mühe gegeben!
Keinen Grund sich schon jetzt zu Entschuldigen. Du wirst bestimmt noch länger hier bei uns bleiben.face-smile

Und wie das mit "Antworten und Zittieren" geht siehst du wenn du anstelle von "Antworten" auf "Mit Zitat" gehstface-smile

Gruß,
Peter
Mitglied: Pjordorf
Pjordorf 15.09.2012 aktualisiert um 18:20:50 Uhr
Goto Top
Hallo,

Zitat von @Armin-K:
Ich bin doch noch auf der Suche nach "KnowHow" in den Tiefen des VBA-Universums
Die F1 Taste im VBA editor ist dein Freundface-smile Und im MSDN (Microsft Developer Network - Offen für jeden) ist alles haarklein definiert und auch mit Beispielen. Sonst im WWW Lesestoff für mehr als ein Menschenlebenface-smile

Leider komme ich nicht weiter
Dann bitte genau angeben wo und was nicht so geht wie du es erwartest. Evtl. mit Zeilennummer und Fehlermeldung denn es hilft uns dich besser zu Verstehen.

Beim Aufruf des Makro soll die Datei als neue Datei gespeichert und geschlossen werden. Eine Bestätigungsabfrage "Speichern" soll nicht mehr gestellt werden.
Und genau das ist auch der Fall. Da kommt keine Abfrage mehr das die Datei schon existiert und ob ich Überschreiben will und dort mit "Ja" - "Nein" - "Abbrechen" Antworten kann. Oder meinst du ganz was anderes?

die Datei stelle ich auch gern per Mail zur Verfügung...
Solange wir hier Öffentlich sind, machen wir das nicht. Andere sollen ja auch hiervon profitieren können.

Wenn das Problem nicht beschreibbar ist hilft es auch mit Bildern zu sagenface-smile Du kannst Bilder hier direkt ins Forum stellen. Dazu bei deiner Eröffnungsfrage auf Bearbeiten gehen und dort Bilder hochladen. Es wird ungern gesehen das wir uns Bilder auf irgendwelchen Filehostern anschauen sollen. Die meisten von uns sind da Allergickerface-smile

Gruß,
Peter
Mitglied: Armin-K
Armin-K 15.09.2012 um 17:44:07 Uhr
Goto Top
Hallo Peter,
schönen Dank noch mal für die Hinweise, ein bisschen habe ich jetzt ja schon gelernt. Ich werde weiter neugierig auf alles was noch so kommt sein und bleibe bestimmt dabei. Die bisherigen Erfahrungen waren da auch schon prima!!!

LG
Mitglied: Pjordorf
Pjordorf 15.09.2012 aktualisiert um 23:53:56 Uhr
Goto Top
Hallo Armin-K,

Zitat von @Armin-K:
vielleicht ahbe ich mich aber auch nicht richtig erklärt
Ich habe dir mal Folgendes anzubieten. Lies dir die kommentare durch.Hier kannst du entscheiden welche Dialoge du haben möchtest. Per direkter festlegung oder per Zellwert (X1). Keine Angst, ist nicht viel. Wenn du die Kommentare weglässt sind es nur 35 Codezeilen
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 Flase 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
Und da ich nicht weiß welchen Dialog du genau meinst habe ich dir mal den "Überschreiben Dialog" sowie den "Speichern Unter Dialog" als Bilder hier eingepapptface-smile

c6e0aa88c55906bc9044627d27770b9c
Speichern Unter Dialog
Dieser kann nicht per Code unterdrückt werden, speziell wo du ihn ja Explizit per .GetSaveAsFileName aufrufst. Da ist eine Benutzerinteraktion dann zwingend von dir erwünschtface-smile

f3ceb7267132bf80fba2bbd3ad69b0cc
Datei Überschreiben Dialog
Dieser Dialog kann mittels .Save oder .SaveAs entsprechend abgefangen werden.

Gruß,
Peter
Mitglied: Armin-K
Armin-K 16.09.2012 um 09:14:05 Uhr
Goto Top
Hallo Peter,

PERFEKT , ich hatte mir das genau so gewünscht!

Ganz lieben Gruß

Armin