Frage zu einem Makro zum wiederholten Öffnen, Bearbeiten, Speichern und Schliessen von Dateien
Hallo, ich habe mich neu angemeldet, da ich hier schon desöfteren Lösungen gefunden habe, bei dem nachfolgend beschriebenen Problem aber nicht weiterkomme. Für Lösungsvorschläge schon im voraus vielen Dank!
Ich möchte mehrere Exceldateien, deren Namen variieren nacheinander öffnen, jeweils in der geöffneten Datei einige Befehle ablaufen lassen, die Datei in einem anderen Netzwerpfad speichern und die Datei wieder schließen. Dann soll die nächste Datei im gleichen Muster folgen, bis alle abgearbeitet sind. Im Ordner der zu bearbeitenden Dateien liegen weitere Dateien, die nicht bearbeitet werden sollen, es ist also eine Auswahl notwendig. Die Anzahl der zu bearbeitenden Dateien variiert.
Das folgende Makro habe ich schon erstellt und es funtioniert wenn ich eine einzelne Datei manuell öffne, dass Makro aufrufe und die Datei danach manuell schliesse:
Sub Format1()
'
' Format1 Makro
'
'
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 10
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
ActiveWorkbook.SaveAs Filename:= _
"\\SERVER\Export\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Was fehlt ist die Auswahl, die Schleife damit die ausgewälten Dateien geöffnet, abgearbeitet und geschlossen werden bis alle ausgewählten Dateien abgearbeitet werden.
Danke für jede Hilfe auch in Teilbereichen
Antwort schreiben
Antwort 1 von coros vom 26.08.2021, 04:28 Options
Hallo joe910,
nacjfolgendes Makro öffnet alle Exceldateien in einem bestimmten Verzeichnis und fürht Deinen Formatierungsstring durch.
Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.Option Explicit
Sub Alle_Exceldateien_formatieren()
Dim objFileSystemObject As Object
Dim objAnzDateien As Object
Dim objDatei As Object
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set objAnzDateien = objFileSystemObject.getfolder("C:\Eigene Dateien\")
For Each objDatei In objAnzDateien.Files
If Right(objDatei.Name, 4) = ".xls" Then
With ActiveSheet.PageSetup
.PrintArea = ""
.PrintTitleRows = ""
.PrintTitleColumns = ""
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 10
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
ActiveWorkbook.SaveAs Filename:= _
"\\SERVER\Export\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
Next
Set objFileSystemObject = Nothing
Set objAnzDateien = Nothing
End Sub
Du musst in dem Makro in der Zeile
Set objAnzDateien = objFileSystemObject.getfolder("C:\Eigene Dateien\")den Pfad noch anpassen, da bei Dir sicherlich ein anderer Pfad abgefragt werden soll.
Was nicht realisiert wurde ist die Aufgabenstellung
Zitat:
....damit die ausgewälten Dateien geöffnet, abgearbeitet und geschlossen werden bis alle ausgewählten Dateien abgearbeitet werden.
Wie werden/ sollen denn die Dateien ausgewählt werden?
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 2 von joe910 vom 26.08.2021, 09:46 Options
Hallo Oliver,
zunächst vielen Dank für die Antwort, ich komme erst heute am Nachmittag dazu Dein Makro zu testen., werde dann berichten.
Zur Frage: Am liebsten (eventuell etwas naiv) wie im Dialog Datei öffnen und dann Mehrfachauswahl mit der Umschalt- oder Strg Taste, je nach Bedarf. Realistischer wahrscheinlich mit so etwas wie einer Listbox. Wichtig ist nur, dass man es nur einmal anstossen muss, da z.T. 50+ Dateien zu verarbeiten sind.
Eingelesen werden übrigens xml Dateien, das hatte ich vergessen zu erwähnen. Aber da muss ich ja nur die Zeile
Zitat:
If Right(objDatei.Name, 4) = ".xls" Then
entsprechend anpassen und dabei das xls durch xml ersetzen.
Gruß, Johannes
Antwort 3 von coros vom 26.08.2021, 11:50 Options
Hallo joe910,
lade Dir mal unter
http://www.excelbeispiele.de/Beispiele_Supportnet/Beispiel_joe910.xls eine Beispieldatei herunter, die ich Dir erstellt habe. Darin wird eine ListBox mit Exceldateien gefüllt. Alle Dateien, die Du markierst, werden dann geöffnet. Du musst allerdings im Modul1 noch den Pfad in der Zeile
Const strPath As String = "H:\"
anpassen. Außerdem musst Du in der Zeile
If Right(objDatei.Name, 4) = ".xls" Then
die Endung anpassen.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 4 von joe910 vom 27.08.2021, 15:17 Options
Hallo Oliver,
leider bin ich erst heute zum Testen gekommen, hier die Resultate:
zu Deiner ersten Antwort:
Ich habe die Pfade und die Endung angepasst. Wenn ich das Makro ausführe wird versucht die geöffnete Datei mehrfach im angegebenen Pfad zu speichern. Es erscheint dann die Meldung, dass die Datei in Zielordner schon vorhanden sei und ob sie überschreben werden soll. Die im unter
Zitat:
Set objAnzDateien = objFileSystemObject.getfolder("C:\Eigene Dateien\")
angebenen Pfad gespeicherten Dateien werden nicht geöffnet, so auch nicht nacheinander bearbeitet und im Zielordner gespeichert.
zu Deiner zweiten Antwort:
Ja, so eine Listbox ist gut nutzbar. Nachteil ist, dass dann wirklich alle 50+ Dateien auf einmal geöffnet werden. In jeder geöffneten kann ich dann natürlich das Makro anstossen, benötigt also Präsenz während der Bearbeitung. Schön wäre halt eine Schleife: Alle benötigten Dateien auswählen und dann wird die erste geöffnet, bearbeitet, gespeichert, geschlossen. Dann kommt die zweite dran. Das ganze so lange, bis alle ausgewählten Dateien abgearbeitet sind.
Gruß,
Johannes
Antwort 5 von coros vom 27.08.2021, 16:27 Options
Hallo Johannes,
das mit der Erweiterung aus meiner 1.Antwort beim Speichern gefragt wird, ist klar, da die eine Datei noch geöffnet ist.
Füge unter derm SaveAs-Befehl noch
Workbooks(Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & ".xls").Close
ein. Damit wird die gerade gespeicherte Exceldatei geschlossen.
Das 2. was Du schreibst, wird doch so gemacht. Es werden alle Dateien, die Du markierst nacheinander geöffnet. ich habe in dem Code dafür nur niht den Close-Befehl eingebaut, damit jede Datei dann wieder geschlossen wird.
Lade Dir mal unter
http://excelbeispiele.de/clicktracker/clicktracker.php?id=641die neue Beispieldatei herunter. Dort wird jede Datei, die Du markierst geöffnet, der Wert aus ZelleA1 ausgelesen und in einer MessageBox angezeigt und danach wieder geschlossen. Anstelle des Aufrufens der MessageBox, musst Du dort den Code, der ausgeführt werden soll, einfügen.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.