Clever-Excel-Forum

Hallo zusammen

Kann mich hier jemand unterstützen ich möchte das bestehende Makro anpassen damit es bereits beim Aufruf den aktuellen Pfad in dem die Excel nimmt, und in der Box einschreibt.

Aktuell nimmt er es aus der Zelle M1.

Hier das aktuelle Makro:

Sub speichern_unter()

Dim lw_pfad As String

'Zelle mit Pfad'
lw_pfad = ActiveSheet.Range("m1").Value
lw_pfad = InputBox("Geben Sie hier das Laufwerk und den neuen Pfad an, wo die Datei gespeichert werden soll." & Chr(13) & Chr(13) & "(Ihre Datei wird am neuen Ort falls Pfad geändert wurde.)", "Datei speichern unter...", lw_pfad)
If lw_pfad = "" Then
  MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
  Exit Sub
Else
  If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
  ActiveSheet.Range("i1").Value = lw_pfad
Rem MsgBox lw_pfad
ActiveWorkbook.SaveAs lw_pfad & ActiveSheet.Range("a1").Value & "_" & ActiveSheet.Range("b3").Value & "_" & _
Format(Day(Date), "00-") & Format(Month(Date), "00-") & Year(Date) & _
".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "Die Datei wurde unter " & lw_pfad & ActiveSheet.Range("a1").Value & ActiveSheet.Range("b3").Value & ".xls gespeichert.", , "OK"
End If
End Sub



Kann mir hier jemand Hilfe leisten?

Danke

Zitat:Registriert seit: 11.02.2015

Bitte, verwende Code Tags.

Hi,

kommt mir bekannt vor, der Code.

Bist du eigentlich ein anderer?


VG Juvee

Vielen Dank es funktioniert.

Kann man die Fehlermeldung Laufzeitfehler 1004 übergehen?
Diese kommt wenn die Datei bereits vorhanden ist und man auf die Abfrage überschreiben Nein klickt.

Ich hatte die Funktion Application.DisplayAlerts = False angeschaut jedoch blendet diese auch aus wenn die Datei bereits vorhanden ist.

Perfekt währe wenn es eine neue Version Speichert als Bsp. eine Zahl hinzufügt. wenn man Nein klickt und bei Abbrechen Abbricht

Danke bereits jetzt.

Hi,

guckst du hier

VG Juvee