Live-Forum - Die aktuellen Beiträge
Datum
Titel
12.05.2024 16:15:58
Achsenabschnittlänge ändern
12.05.2024 15:53:59
VBA -> Gruppierung mittels Liste
12.05.2024 12:28:15
Index Vergleich such Kriterien wenn sonst wert
12.05.2024 10:04:21
Zellbezug zeigen anderes Arbeitsblatt
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1724to1728
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1724to1728
1724to1728
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Speichern in zwei unterschiedliche Pfade

Speichern in zwei unterschiedliche Pfade
27.11.2019 11:26:40
speednetz

Hallo
Ich brauche mal Hilfe
Ich Speicher meine Originaldatei mit einem Makro was den Pfad und den Dateinamen aus Zellen bezieht:
Dateiname der Originaldatei Rechnungsprogramm
Pfad = Worksheets("Rechnungsformular").Range("AT5")
Ordner = Worksheets("Rechnungsformular").Range("AT7") & "" & Range("AT9").Value
DateiName = Worksheets("Rechnungsformular").Range("F30") & " " & Format(Range("G30"), "0000") & " " & (Range("C24")) & " " & ".xlsm"
ThisWorkbook.SaveCopyAs Filename:=strPfad & strDateiName
Läuft auch.
Nun mein Problem:
Wenn ich aus dem Speicherordner eine Datei aufrufe und ich etwas ändere und sie wird dann unter einem neuen Namen wieder gespeichert, möchte ich das diese in den gleichen Ordner gespeichert wird. Jetzt ist es so das beim Speichern ein weiterer Ordner erstellt wir wo dann gespeichert wird.
Kommt wahrscheinlich da her das der Pfad einen unter Ordner mehr aus liest.
Vielleicht hat ja jemand eine Lösung für mein Problem.
Ansatz wäre vielleicht so im Makro Dateiname Rechnungsprogramm
Pfad = Worksheets("Rechnungsformular").Range("AT5")
Ordner = Worksheets("Rechnungsformular").Range("AT7") & "" & Range("AT9").Value
Wenn Datei Name nicht bekannt dann
Pfad = Worksheets("Rechnungsformular").Range("AU5")
Ordner = Worksheets("Rechnungsformular").Range("AU7") & "" & Range("AU9").Value
Ich hoffe ich habe mich einiger maßen verständlich aus ausgedrückt.
Wäre nett, wenn mir hier bei jemand helfen könnte.
Gruß Ralf

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Speichern in zwei unterschiedliche Pfade
27.11.2019 11:37:48
Armin
Hallo Ralf,
lade bitte mal Dein Makro am besten mit ein, zwei Daten hoch. Das müsste mi Deinem Makro zusammen hängen.
Gruß Armin
AW: Speichern in zwei unterschiedliche Pfade
27.11.2019 14:37:48
speednetz
Hallo
Danke erst mal für die Hilfe
Hier das Mkro und im Anhang die Datei
Private Sub CommandButton3_Click()
' Drucken Rechnung
ActiveSheet.Unprotect
'Call Rechnumgsnummer_vergessen
If Range("AT30").Value = "0" Then
MsgBox "Rechnungsnummer!"
Exit Sub
End If
If Range("C24").Value = "" Then
MsgBox "Name fehlt!"
Else
If Range("F28").Value = "" Then
MsgBox "Datum fehlt!"
Else
If Range("F28").Value = "" Then
MsgBox "Datum fehlt!"
Else
If Range("C70").Value = "" Then
MsgBox "Zahlbar bis fehlt!"
Else
End If
ActiveSheet.Cells.EntireRow.Hidden = False
Dim Kopien As Variant
Range("B23").Select
Selection.ClearContents
Range("B24").Select
Selection.ClearContents
Range("B25").Select
Selection.ClearContents
Range("B26").Select
Selection.ClearContents
Range("B30").Select
Selection.ClearContents
Range("B41:B64").Select
Selection.ClearContents
ActiveSheet.Range("C23").Interior.ColorIndex = xlNone
ActiveSheet.Range("C24").Interior.ColorIndex = xlNone
ActiveSheet.Range("C25").Interior.ColorIndex = xlNone
ActiveSheet.Range("C26").Interior.ColorIndex = xlNone
ActiveSheet.Range("C30").Interior.ColorIndex = xlNone
ActiveSheet.Range("F28").Interior.ColorIndex = xlNone
ActiveSheet.Range("G28").Interior.ColorIndex = xlNone
ActiveSheet.Range("F30").Interior.ColorIndex = xlNone
ActiveSheet.Range("G30").Interior.ColorIndex = xlNone
ActiveSheet.Range("C60").Interior.ColorIndex = xlNone
ActiveSheet.Range("F64").Interior.ColorIndex = x1None
ActiveSheet.Range("C70").Interior.ColorIndex = xlNone
Range("B1:G85").Select
Range("G85").Activate
ActiveSheet.PageSetup.PrintArea = "$B$1:$G$85"
If MsgBox("Drucken?", vbYesNo, "Drucken") = vbYes Then
Do
Kopien = InputBox("Anzahl Kopien", "Drucken", 1)
If StrPtr(Kopien) = 0 Then Exit Sub
If IsNumeric(Kopien) Then Exit Do
MsgBox "Bitte eine Zahl eingeben!", vbExclamation, "Hinweis"
Loop
ActiveSheet.PrintOut From:=1, To:=1, Copies:=CLng(Kopien)
End If
ActiveSheet.Range("C23").Interior.ColorIndex = 6
ActiveSheet.Range("C24").Interior.ColorIndex = 6
ActiveSheet.Range("C25").Interior.ColorIndex = 6
ActiveSheet.Range("C26").Interior.ColorIndex = 6
ActiveSheet.Range("C30").Interior.ColorIndex = 6
ActiveSheet.Range("F28").Interior.ColorIndex = 6
ActiveSheet.Range("G28").Interior.ColorIndex = 6
ActiveSheet.Range("F30").Interior.ColorIndex = 6
ActiveSheet.Range("G30").Interior.ColorIndex = 6
ActiveSheet.Range("C60").Interior.ColorIndex = 6
ActiveSheet.Range("F64").Interior.ColorIndex = 6
ActiveSheet.Range("C70").Interior.ColorIndex = 6
Range("B23").Value = "Anrede:"
Range("B24").Value = "Name:"
Range("B25").Value = "Straße:"
Range("B26").Value = "PLZ-Stadt:"
Range("B30").Value = "mail:"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
Rows("1:18").Select
Selection.EntireRow.Hidden = True
ActiveSheet.Protect
Range("C23").Select
End If
End If
End If
End Sub


Private Sub CommandButton4_Click()
'Neue Rechnung
ActiveSheet.Unprotect
Range("B41:F57").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=30
Range("C23").Select
Selection.ClearContents
Range("C24").Select
Selection.ClearContents
Range("C25").Select
Selection.ClearContents
Range("C26").Select
Selection.ClearContents
Range("F28").Select
Selection.ClearContents
Range("G28").Select
Selection.ClearContents
Range("C30").Select
Selection.ClearContents
Range("C60").Select
Selection.ClearContents
Range("C70").Select
Selection.ClearContents
Range("B23").Value = "Anrede:"
Range("B24").Value = "Name:"
Range("B25").Value = "Straße:"
Range("B26").Value = "PLZ-Stadt:"
Range("B30").Value = "mail:"
ActiveSheet.Range("C23").Interior.ColorIndex = 6
ActiveSheet.Range("C24").Interior.ColorIndex = 6
ActiveSheet.Range("C25").Interior.ColorIndex = 6
ActiveSheet.Range("C26").Interior.ColorIndex = 6
ActiveSheet.Range("C30").Interior.ColorIndex = 6
ActiveSheet.Range("F28").Interior.ColorIndex = 6
ActiveSheet.Range("G28").Interior.ColorIndex = 6
ActiveSheet.Range("F30").Interior.ColorIndex = 6
ActiveSheet.Range("G30").Interior.ColorIndex = 6
ActiveSheet.Range("C60").Interior.ColorIndex = 6
ActiveSheet.Range("F64").Interior.ColorIndex = 6
ActiveSheet.Range("C70").Interior.ColorIndex = 6
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
' , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
' AllowFormattingRows:=True, AllowFiltering:=True
Sheets("Rechnungsformular").Range("F64").Value = "19%"
ActiveSheet.Protect
Range("C23").Select
End Sub
https://www.herber.de/bbs/user/133462.xlsm
Danke schon mal
Gruß Ralf
Anzeige
AW: Speichern in zwei unterschiedliche Pfade
29.11.2019 13:35:47
MAtthias
Moin!
Hier mal eine Idee. Ist leider ungetestet, da nach dem Speichern die gespeicherte Datei immer abstürzte.
In At 5 steht ja der aktuelle Pfad der Datei. Der GEdanke ist, beim Speichern zu prüfen, ob im Namen schon der Ordner vorkommt. Der wird ja in At9 festgelegt. Ist der Ordnername nicht da, so wird er angelegt ansonsten weggelassen. Mann könnte auch noch prüfen, ob der Ordnername, der letzte Teil im Pfad ist, so dass nur abgebrochen wird, wenn der Ordnername zweimal hintereinander kommt. Hier mal ein Beispiel für die erste Idee. 
strPfad = Worksheets("Rechnungsformular").Range("AT5")
If InStr(1, strPfad, Range("AT9").Value, vbTextCompare) = 0 Then
'Rechnungen ist noch nicht im NAmen also den ORdner hinzufügen
strPfad = strPfad & Worksheets("Rechnungsformular").Range("AT7") & "" & Range("AT9").Value & _
If Dir(strPfad, vbDirectory) = "" Then
MkDir (strPfad)
End If
End If
strDateiName = Worksheets("Rechnungsformular").Range("F30") & "  " & Format(Range("G30"), "0000" _
) & "  " & (Range("C24")) & " " & ".xlsm"
ThisWorkbook.SaveCopyAs Filename:=strPfad & strDateiName

Im Pfad wird nach dem Ordner gesucht. Ist er nicht da, wird der Ordnername und ein \ hinzugefügt ansosnten wird der strpfad gelassen. Die Variabel für den Ordner brauchst du damit dann nicht mehr benutzen. Die Prüfung nach dem Ordner ist auch nur in der SChleife notwendig, da er ansonsten ja schon vorlag (war ja im PFadnamen drin).
VG
Anzeige
AW: Speichern in zwei unterschiedliche Pfade
29.11.2019 20:36:49
speednetz
Hallo Matthias
Danke estmal für deine Hilfe.
Konnte leider nich früher antworten. Bin eben er aus der Schweiz zurück gekommen.
Werde es morgen ausprobieren und mich dann melden.
Gruß Ralf
AW: Speichern in zwei unterschiedliche Pfade
30.11.2019 08:01:18
Hajo_Zi
offen bedeutet es soll noch eine Antwort kommen.
Warum ist dein Beitrag Offen.
Du willst doch was machen. Soll jemand vorbei kommen?
Das ist nur meine Meinung zu dem Thema.

AW: Speichern in zwei unterschiedliche Pfade
30.11.2019 10:02:24
speednetz
Guten Morgen Matthias
Ich habe den Code ausprobiert, und er läuft auch soweit.
Zwei Punkte habe ich die nicht ganz passen.
1
Er speichert aus der Originaldatei immer in den Ordner Rechnungen
das läuft auch. Wenn ich jetzt aber aus dem Ordner Rechnungen eine etwas ältere Datei aufrufe, wo ich dann was ändere und sie dann wieder speichere, mit einer neuen Rechnungsnummer soll diese dann auch in den Ordner Rechnungen gespeichert werden. Mit deinem Code speichert er sie mir jetzt in einem Ordner da rüber also in Rechnung das ist nicht richtig.
Beim Speicher mit dem Original ist er abgekürzt Pfad so:
Desktop\Rechnung\Rechnungen
Bei deinem Code ist er jetzt:
Desktop\Rechnung
2
Kannst du es auch so ändern das er nicht den Namen zum Prüfen benutzt, sondern die Rechnungsnummer. Es dürfen halt keine doppelten Nummern erstellt werden.
Wäre schön wenn das so zu ändern wäre.
Ich hoffe das ich mich einiger maßen verständlich machen konnte.
Gruß Ralf
Anzeige
AW: Speichern in zwei unterschiedliche Pfade
30.11.2019 17:16:56
Matthias
Moin!
Also das mit dem Ordner ist behoben. Hatte mich da vertan und ein Backslash vergessen. Jetzt passt es. Bzgl. der doppelten Nummern, weiß ich nicht genau den Ablauf deines Programms. Wenn du eine alte Datei aufmachst und was änderst (außer die Recnungsnr), soll nur die Datei gespeichert werden aber nicht eine neue Datei angelegt werden. Das habe ich jetzt so gelöst, dass dann nur gespeichert wird. Was soll aber passieren, wenn es schon eine Datei gibt (weil du bspw. eine andere Rechnungsnummer eingibst)? DAfür habe ich jetzt mal eine MSGBOX drin. Da kann / sollte man ggf. noch was anpassen. 
strPfad = Worksheets("Rechnungsformular").Range("AT5") & "\"
If InStr(1, strPfad, Range("AT9").Value, vbTextCompare) = 0 Then
'Rechnungen ist noch nicht im NAmen also den ORdner hinzufügen
strPfad = strPfad & Worksheets("Rechnungsformular").Range("AT7") & "" & Range("AT9"). _
Value & "\"
If Dir(strPfad, vbDirectory) = "" Then
MkDir (strPfad)
End If
End If
strDateiName = Worksheets("Rechnungsformular").Range("F30") & "  " & Format(Range("G30"), " _
0000") & "  " & (Range("C24")) & " " & ".xlsm"
If ActiveWorkbook.Name = strDateiName Then
ThisWorkbook.Save
Else
If Dir(strPfad & strDateiName) <> "" Then
MsgBox "Die Datei existiert schon. Sie wird jetzt überschrieben!"
ThisWorkbook.SaveCopyAs Filename:=strPfad & strDateiName
End If
End If

Bei der Prüfung bin ich jetzt nicht nach der Nummer sondern dem Dateinamen gegangen. Da wird ja die Nummer eh schon genutzt und die Namenserstellung ist auch immer die selbe. Wollte das nicht doppelt erstellen - könnte man aber auch komplett auf die Nummer umbauen.
VG
Anzeige
AW: Speichern in zwei unterschiedliche Pfade
01.12.2019 16:53:29
speednetz
Hallo Matthias
Ich habe deinen Code bei mir eingesetzt er läuft zwar durch, aber ich weiß nicht wo er jetzt hin speichert.
Vielleicht habe ich mich auch ein bisschen falsch ausgedrückt.
Ich versuche es mal anders zu formulieren.
Ich bräuchte ein Makro was aus jeder Datei, die geöffnet wird, ob Rechnungsprogramm oder eine schon gespeicherte Rechnung sie immer, wenn sie neu speichere oder sie nur wieder geschlossen wird in den Ordner Pfad: ……. \Rechnung\Rechnungen gespeichert wird.
Wenn möglich ohne Pfadangabe da sich diese gegebenen falls ändern kann.
Das prüfen ob diese Rechnungsnummer schon vorhanden ist, wir jetzt vorher geprüft.
Wäre schön, wenn ich hier für eine Lösung bekommen könnte.
Sonst muss ich es mit drei einzelnen Makros versuchen es zu lösen.
Wäre schon, wenn es funktionieren würde.
Danke schon mal
Gruß Ralf
Anzeige
AW: Speichern in zwei unterschiedliche Pfade
01.12.2019 22:50:20
Matthias
Moin!
Also im Code gestern war noch ein Fehler. Deshalb hat er nicht gespeichert. HIer nochmal. Man könnte das auch anders schreiben, aber so hast du die Möglichkeit im Zweig beim Überschreiben noch was zu ändern. 
If Dir(strPfad & strDateiName) <> "" Then
MsgBox "Die Datei existiert schon. Sie wird jetzt überschrieben!"
ThisWorkbook.SaveCopyAs Filename:=strPfad & strDateiName
Else
ThisWorkbook.SaveCopyAs Filename:=strPfad & strDateiName
End If
Mal noch ein paar Fragen zum letzten Beitrag bzgl ohne Pfadangabe:
Irgendwo musst du aber einen Pfad angeben bzw. hernehmen. Bisher kommt der ja aus dem Dateipfad, in AT5. Alternativ könnte man das auch aus dem Pfad der Datei herauslesen. Dann wäre aber die Frage, ob alle Dateien (alte und Rechnungsprogramm) schon immer in dem Ordnerpfad liegen (also unter Rechnung\Rechnungen). Wenn ja, liegen die dann auch noch tiefer bspw. Rechnung\Rechnungen\alte\archiv und die Speicherung soll dann in Rechnung\Rechnungen abgelegt werden? Liegen die nicht in dem PFad, müsste man irgendwo was hinterlegen. Evtl. nochmal an einem Beispiel (mit Pfadangaben) erklären, was wo liegt (pfad) und wohin es soll (pfad). Sollte m.E. kein Problem sein, weiß aber nicht genau, wie deine Ablage aufgebaut ist und wo was liegt.
VG
Anzeige
AW: Speichern in zwei unterschiedliche Pfade
03.12.2019 08:20:57
speednetz
Morgen Matthias
Ich habe denn Code bei mir eingesetzt leider läuft er bei mir nicht.
Da ich die Datei brauche habe ich nun das Tabellenblatt in denn gleichen Ordner wie die zu speichernden Tabellen hinterlegt.
Somit werden jetzt alle zu speichernden Dateien in diesem Ordner
Gespeichert. Also die aus dem Original Rechnungsprogramm so wie auch die, wenn ich eine gespeicherte Rechnung öffne und sie mit einer neuen Rechnungsnummer wieder speichere.
Zu deiner Frage:
Ohne Pfadangabe mein Gedanke ist, dass ich immer in den Ordner Rechnungen Speicher egal ob ich das Original Rechnungsprogramm offen ist:
Liegt im Pfad: C:\Users\speed\Desktop\Rechnung
Öffne ich eine schon gespeicherte Rechnung die
Liegt im Pfad: C:\Users\speed\Desktop\Rechnung\Rechnungen
Der Gedanke ist ohne Pfad Angabe das ich den Ordner Rechnung
Über all verwenden kann. Also auf jedem Rechner und unter dem Laufwerksbuchstaben.
Ich hoffe ich habe mit meinen Worten deine Frage einiger maßen beantwortet.
Vielleicht gibt es ja doch eine Lösung dafür.
Wäre schön dann hätte ich die Original Datei nicht im gleichen Ordner wie die Rechnungen.
Aber danke erstmal das du mir so bei diesem Problem behilflich bist.
Danke Gruß Ralf
Anzeige
AW: Speichern in zwei unterschiedliche Pfade
03.12.2019 18:36:02
Matthias
Moin!
Also habe mal was gebastelt, was hoffentlich deinen Vorgaben nahekommt. Habe es mal in eine Sub gepackt. Die könntest du nach deinen Prüfungen aufrufen (an Stelle des bisherigen Codes) oder den Codeteil aus der Sub dorthin kopieren - wäre egal.
NAch deinen Vorgaben wird nun aus dem Dateipfad der Pfad zu ...\Rechnung\ gesucht. Wird er nicht gefunden, kann man ihn manuell suchen. Damit geht das auch für Dateien, die noch nicht in der richtigen Ablage liegen oder rauskopiert wurden. Anschließend wird der Unterordner Rechnungen\ erstellt.
Dann wird ausgehen vom (neuen) Dateinamen die Datei dort gespeichert. Dabei wird je nach Möglichkeit (neu, Änderung in aktueller, Name schon vergeben) unterschieden. Das Überschreiben eine bereits vorhandenen Datei wird nur angezeigt. Da hat man (noch) keine Möglichkeit das zu unterbinden, abzubrechen. Der Pfad wird wie geschrieben an Hand vom Dateinamen erstellt. Damit ist das vom System und Vorgaben unabhängig - im Pfad kommt ja schon das Laufwerk und der PFad vor. Die Zellen in Spalte AT sind egal. Du könntest dort und im Code aber noch Änderungen vornehmen. BSpw. wenn der Ordner nicht Rechnungen sein soll sondern ein anderer Name.
Der Code geht natürlich nur für neu angelegte Dateien. Alternativ kannst du da ja ggf. als addin umbasteln. Dann brauchst du später bei Änderungen nicht in jeder Datei was ändern.
Lange Vorrede, hier nun der Code. Einfach mal durchtesten und ggf. mit F8 im Einzelschritt durchgehen. Habe auch ein paar Kommentare eingebracht. 
Sub pfadspeichern()
Dim strDateiName As String, strpfad As String
Dim auswahl As Long
strpfad = ThisWorkbook.FullName
'prüfen ob der Ordnung den Term Rechnung\beinhaltet, wenn nicht manuell öffnen
While InStr(1, strpfad, "Rechnung\", vbTextCompare) = 0
auswahl = MsgBox("Es konnte noch nicht der richtige Ordnerpfad ermittelt werden. Bitte  _
suchen sie den Pfad manuell!", vbOKCancel, "falscher Ordner")
If auswahl = 2 Then Exit Sub
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = datpfad
.Title = "Ordnerauswahl"
If .Show = -1 Then
strpfad = .SelectedItems(1)
If Right(strpfad, 1) <> "\" Then strpfad = strpfad & "\"
End If
End With
Wend
'pfad nochmal zurechtstutzen
strpfad = Left(strpfad, InStr(1, strpfad, "Rechnung\", vbTextCompare) + Len("Rechnung\") - 1)
'prüfen ob Rechnungen vorhanden sonst anlegen
strpfad = strpfad & "Rechnungen" & "\"      'Rechnungen ggf. durch cells(At9) ersetzen
If Dir(strpfad, vbDirectory) = "" Then MkDir (strpfad)
strDateiName = Worksheets("Rechnungsformular").Range("F30") & "  " & Format(Range("G30"), "    _
0000") & "  " & (Range("C24")) & " " & ".xlsm"
'prüfen ob die Datei den selben Namen hat
If ActiveWorkbook.Name = strDateiName Then
ThisWorkbook.Save
Else
'anderer Name als prüfen ob anlegen oder überschreiben
If Dir(strpfad & strDateiName) <> "" Then
'das könnte man noch abfangen
MsgBox "Die Datei existiert schon. Sie wird jetzt überschrieben!"
ThisWorkbook.SaveCopyAs Filename:=strpfad & strDateiName
Else
'neu speichen
ThisWorkbook.SaveCopyAs Filename:=strpfad & strDateiName
End If
End If
End Sub

Nochmal als HInweis. Entweder so: 
   Else
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' _
Call pfadspeichern
Range("C23").Select

oder den Code an Stelle vom call pfadspeichern.
VG
Anzeige
AW: Speichern in zwei unterschiedliche Pfade
05.12.2019 19:11:01
speednetz
Hallo Mattias
Ich bin erst heute zurückgekommen.
Deshalb melde ich mich erst jetzt.
Danke erst mal für deine Mühe.
ich werde deinen Code jetzt am Wochenende ausprobieren.
Ich werde mich dann melden wie es läuft.
Danke erstmal.
Gruß Ralf

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige