Speichern unter mit Dateinamen aus Zelle

Sub Berechnung_speichern() antwort = MsgBox("Berechnung für" & vbLf & Sheets("Eingabe").Range("D9") & vbLf & "speichern?", vbExclamation + vbYesNoCancel, "Tool") If antwort = 6 Then ThisWorkbook.SaveAs Dim NeuerName As String, Speicherpfad As String Speicherpfad = "C:\\Test\Berechnungen\" NeuerName = Sheets("Eingabe").Range("D9") ActiveWorkbook.SaveAs Filename:=NeuerName End If If antwort = 7 Then ThisWorkbook.Saved = True Application.Quit ElseIf antwort = 2 Then End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_BeforeClose(Cancel As Boolean) Call Berechnung_speichern End Sub Sub Berechnung_speichern() Dim NeuerName As String, Speicherpfad As String, antwort antwort = MsgBox("Berechnung für" & vbLf & Sheets("Eingabe").Range("D9").value & vbLf & "speichern?", vbExclamation + vbYesNoCancel, "Tool") Select Case antwort Case 6 Speicherpfad = "C:\Test\Berechnungen\" NeuerName =Sheets("Eingabe").Range("D9").value ActiveWorkbook.SaveAs Filename:=Speicherpfad & NeuerName, FileFormat:=xlOpenXMLWorkbookMacroEnabled Case 7 ThisWorkbook.Saved = True Application.Quit Case Else End Select End Sub

Sub Berechnung_speichern() Dim NeuerName As String, Speicherpfad As String, antwort antwort = MsgBox("Berechnung für" & vbLf & Sheets("Eingabe").Range("D9").Value & vbLf & "speichern?", vbExclamation + vbYesNoCancel, "Tool") Select Case antwort Case 6 Speicherpfad = "C:\Test\Berechnungen\" NeuerName = Sheets("Eingabe").Range("D9").Value ActiveWorkbook.SaveAs Filename:=Speicherpfad & NeuerName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.Quit Case 7 ThisWorkbook.Saved = True Application.Quit Case Else End Select End Sub

Hallo Ralf,
da muss dir nichts leid tun, bist ja kein Hellseher. Und wenn ich mich nicht klar ausdrücke oder selber nicht weiß was ich will, hast du es schwer mir zu helfen.
Aber das Teil macht jetzt schon zu 90 % was es soll.
Es speichert mir die Datei dahin wo ich sie haben will, mit dem Namen des Objektes, dem Datum der Berechnung, und dem Bearbeiter. Sollt nun eigentlich keine Doppelten mehr vorkommen.
Nun würde ich gerne, bevor gespeichert wird, abfangen wenn im Feld "Eingabe D9" nichts steht, soll das Programm einen Hinweis geben ( Antwort2 ) und nichts machen. Bei meinem Versuch speichert mir das Programm aber leider eine Datei ohne Namen, aber mit Datum und Bearbeiter.
Das Programm soll eigentlich nur vor dem speichern überprüfen, ob in dem Feld was steht oder nicht.
Steht dort etwas kann es zum speichern gehen, steht dort nichts, einfach Box schließen und nichts machen.


Sub Berechnung_speichern()
Dim NeuerName As String, Speicherpfad As String, antwort
antwort = MsgBox("Berechnung für" & vbLf & Sheets("Eingabe").Range("D9").Value & vbLf & "speichern?", vbExclamation + vbYesNoCancel, "ImmoGrandeTool")
Select Case antwort
Case 6
Speicherpfad = "C:\ImmoGrandeTool\Berechnungen\"
NeuerName = Sheets("Eingabe").Range("D9").Value
ActiveWorkbook.SaveAs Filename:=Speicherpfad & NeuerName & " - " & Date & " - " & Sheets("Eingabe").Range("G27") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.Quit
Case 7
ThisWorkbook.Saved = True
Application.Quit
Case Else
End Select
End Sub

Das funktioniert perfekt !!
Nun mein Versuch :-(


Sub Berechnung_speichern()
'speichert die aktuelle Berechnung mit dem Namen des Objekte, dem aktuellen Datum und dem Namen des Bearbeiters
'im Ordner C:\ImmoGrandeTool\Berechnungen
Dim NeuerName As String, Speicherpfad As String, antwort1, antwort2
antwort1 = MsgBox("Berechnung für" & vbLf & Sheets("Eingabe").Range("D9").Value & vbLf & "speichern?", vbExclamation + vbYesNoCancel, "ImmoGrandeTool")
'Wenn das Feld "Objekt" (Eingabe D9) keine Daten enthält, wird ein MsgBox mit einem Fehler angezeigt
'und das Speichern wird abgebrochen.
If WorksheetFunction.CountA(Sheets("Eingabe").Range("D9"))

Es währe toll, wenn du mir noch einmal auf die Sprünge helfen könntest.
Viele Grüße
Edmund

If Sheets("Eingabe").Range("D9").value="" Then MsgBox("Berechnung kann nicht gespeichert werden" & vbLf & _ "Es wurde keine Adresse angegeben!", vbCritical + vbOKOnly, "ImmoGrandeTool") exit sub End If

Beliebteste Forumthreads (12 Monate)

Speichern unter mit Dateinamen aus Zelle

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Speichern unter mit Dateinamen aus Zelle

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread