22.08.2022, 17:40
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
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