Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Alle Dateien in einem Ordner öffnen und Code ausfü

Alle Dateien in einem Ordner öffnen und Code ausfü
20.05.2015 09:49:01
pH
Hallo zusammen,
ich habe ein kleines Problemchen, bei dem ich ohne eure Hilfe wohl nicht weiterkomme.
Ich möchte aus einem separaten File heraus alle .XLSM-Dateien im gleichen Verzeichnis öffnen, einen bestimmten Code ausführen und die ganze Geschichte wieder schließen.
So weit, so gut. In den Tiefen des Internets habe ich nun folgenden Code gefunden, der mit verschiedenen Codes / Makros eigentlich auch macht, was er soll:
Option Explicit
Const strPath As String = "C:\Test\"
Sub Main()
Dim strDateiname As String
Dim wkbBook As Workbook
Dim lngLastRowQ As Long
Dim lngLastRowZ As Long
Dim lngLastCol As Long
Dim intCalc As Integer
On Error GoTo Fin
With Application
.ScreenUpdating = False
.AskToUpdateLinks = False
.EnableEvents = False
intCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
'strDateiname = Dir$(ThisWorkbook.Path & "\*.xls")
strDateiname = Dir$(strPath & "*.xlsm")
Do While strDateiname ""
If strDateiname ThisWorkbook.Name Then
Set wkbBook = Workbooks.Open(strPath & strDateiname)
' Hier jetzt Dein Code!!!
wkbBook.Close False ' Oder True, wenn gespeichert werden soll
Set wkbBook = Nothing
End If
strDateiname = Dir$()
Loop
Fin:
Set wkbBook = Nothing
With Application
.ScreenUpdating = True
.AskToUpdateLinks = True
.EnableEvents = True
.Calculation = intCalc
.DisplayAlerts = True
End With
If Err.Number 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Nun hat mir in einem Forum ein netter Kollege vor ein paar Monaten folgenden Code gestrickt, um sämtliche Daten eines Files wochenweise auszudrucken:
Sub Wochenbelege_Drucken()
Dim colKWJahr As Collection
Dim varKWJahr As Variant
Dim lngKW As Long
Dim lngJahr As Long
Application.ScreenUpdating = False
With Tabelle1
.PageSetup.PrintTitleRows = "$1:$1"
If .AutoFilterMode Then .AutoFilterMode = False
With .Range("A1").CurrentRegion
Set colKWJahr = getKW_Jahr_Unikate(.Columns(13).Resize(, 2).Offset(1))
For Each varKWJahr In colKWJahr
lngKW = varKWJahr(0)
lngJahr = varKWJahr(1)
.AutoFilter Field:=13, Criteria1:=lngKW
.AutoFilter Field:=14, Criteria1:=lngJahr
' Drucken
.Worksheet.AutoFilter.Range.PrintOut 1, , 1
' PDF-Ausgabe
' .Worksheet.AutoFilter.Range.ExportAsFixedFormat _
' Type:=xlTypePDF, _
' Filename:=ThisWorkbook.Path & "\" & lngJahr & "_" & Format(lngKW, "00") & " " & Replace(ThisWorkbook.Name, ".xlsm", ".pdf"), _
' Quality:=xlQualityStandard, _
' IncludeDocProperties:=True, _
' IgnorePrintAreas:=False, _
' OpenAfterPublish:=False
.AutoFilter Field:=13
.AutoFilter Field:=14
Next
Set colKWJahr = Nothing
End With
.AutoFilterMode = False
End With
End Sub
Private Function getKW_Jahr_Unikate(Bereich As Range) As Collection
Dim avarDaten As Variant
Dim lngIndexD As Long
Dim lngKW As Long
Dim lngJahr As Long
avarDaten = Bereich.Value
Set getKW_Jahr_Unikate = New Collection
On Error Resume Next
For lngIndexD = LBound(avarDaten) To UBound(avarDaten)
If Not IsEmpty(avarDaten(lngIndexD, 1)) Then
If Not IsEmpty(avarDaten(lngIndexD, 2)) Then
lngKW = CLng(avarDaten(lngIndexD, 1))
lngJahr = CLng(avarDaten(lngIndexD, 2))
getKW_Jahr_Unikate.Add Array(lngKW, lngJahr), lngKW & "_" & lngJahr
End If
End If
Next
End Function

Auch dieser Code funktioniert, für sich genommen, ausgezeichnet.
Ich wollte mir nun ein wenig Arbeit ersparen und eben dieses Drucken für jede Excel-Datei in C:\Test\ automatisch durchführen.
Ich weiß nun allerdings nicht, wie ich beide Codes so kombinieren kann, dass Excel auch tut, was ich von ihm möchte.
Da alle Versuche, die beiden Codes zu kombinieren, scheiterten und diverse Fehler ausgaben, habe ich probiert, ein Modul in Personal.XLSB anzulegen und dieses aufzurufen.
Hierzu habe ich an der Stelle "'Hier jetzt dein Code" die folgende Zeile eingebaut:
Application.Run ("Personal.xlsb!Wochenbelege_Drucken")
Excel beginnt auch zu arbeiten und stürzt nach einiger Zeit ab. Andere Makros wiederum funktionieren.
Ich habe dann einige Zeit bei Google verbracht und schließlich vermutet, dass ich Excel vielleicht ein wenig mehr Zeit zum arbeiten geben muss. Letztendlich kam dabei dann folgendes heraus:
Application.Run ("Personal.xlsb!Register_Drucken")
Application.Wait Now + TimeSerial(0, 0, 15)
Leider führt dies immer noch zu einem Excel-Absturz und auch dazu, dass mir langsam die Ideen ausgehen.
Könnte mir vielleicht jemand von den Experten hier weiterhelfen?
Schon mal vielen Dank im Voraus!!!
Schöne Grüße
pH

Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Alle Dateien in einem Ordner öffnen und Code ausfü
20.05.2015 10:12:27
pH
Hallo noch mal,
ich habe leider gerade erst gelesen, dass Nicks hier nicht unbedingt erwünscht sind.
Leider habe ich nicht herausgefunden, wie ich meinen ersten Beitrag noch editieren könnte.
Sorry dafür!
Ich werde mich zukünftig natürlich an eure Gepflogenheiten halten.
Schöne Grüße
Mike
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige