Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 10:38:52
Bedingte Formatierung per VBA / MaxPoint
25.04.2024 10:30:04
Suche mit MINWENNS und Rückgabe mehrerer Werte
25.04.2024 09:47:49
Daten aus mehreren Dateien untereinander importieren
25.04.2024 09:31:31
Bild "In Zelle platzieren"
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1860to1864
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
1860to1864
1860to1864
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Arbeitsblätter drucken

Arbeitsblätter drucken
08.12.2021 16:17:43
berte
Hallo,
beigefügt ein Makro zum Öffnen, Drucken und Schließen von Dateien.
Das Makro funktioniert auch ganz gut, jedoch möchte ich nun ein paar Abfragen (Dateiname, Name Arbeitsblatt und Anzahl Kopien) einbauen, da die Auswahl sich ständig ändern kann.
Irgendwie klappt es aber mit dem Bezug auf eine Zelle nicht. Ich hänge mal die Datei mit an:
https://www.herber.de/bbs/user/149688.xlsm
Ist hoffentlich nichts Großes! Vielen Dank im Voraus!
Gruß
berte

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Arbeitsblätter drucken
08.12.2021 16:30:56
UweD
Hallo
so?

Sub AlleDrucken()
Dim arrFiles As Variant
Dim iCounter As Integer
Dim sPath As String, TB As Worksheet
Dim sExt As String, sMonat As String, iAnz As Integer
On Error GoTo ERRORHANDLER
Set TB = Sheets("worksheets per Makro drucken")
Application.ScreenUpdating = False
Application.EnableEvents = False
With TB
sPath = .Range("B1").Value
sExt = .Range("B3").Value
sMonat = .Range("B5").Value
iAnz = .Range("B7").Value
arrFiles = FileArray(sPath, sExt)
If arrFiles(1)  False Then
For iCounter = 1 To UBound(arrFiles)
Workbooks.Open sPath & arrFiles(iCounter), False, True
Worksheets(sMonat).Activate
ActiveSheet.PrintOut Copies:=iAnz
ActiveWorkbook.Close savechanges:=False
Next iCounter
End If
End With
ERRORHANDLER:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
LG UweD
Anzeige
AW: Arbeitsblätter drucken
08.12.2021 16:42:31
berte
Hi UweD,
das ist ja der Hammer, vielen Dank, aber irgendwas funktioniert nicht:
arrFiles = FileArray(sPath, sExt)
FileArray wird blau hintelegt!
Gruß
berte
AW: Arbeitsblätter drucken
08.12.2021 16:51:05
UweD
Hallo nochmal
dann hast du das Zweite Makro weggelöscht.
Das ist unverändert gebleiben
Hier nochmal alles komplett

Option Explicit
Sub AlleDrucken()
Dim arrFiles As Variant
Dim iCounter As Integer
Dim sPath As String, TB As Worksheet
Dim sExt As String, sMonat As String, iAnz As Integer
On Error GoTo ERRORHANDLER
Set TB = Sheets("worksheets per Makro drucken")
Application.ScreenUpdating = False
Application.EnableEvents = False
With TB
sPath = .Range("B1").Value
sExt = .Range("B3").Value
sMonat = .Range("B5").Value
iAnz = .Range("B7").Value
arrFiles = FileArray(sPath, sExt)
If arrFiles(1)  False Then
For iCounter = 1 To UBound(arrFiles)
Workbooks.Open sPath & arrFiles(iCounter), False, True
Worksheets(sMonat).Activate
ActiveSheet.PrintOut Copies:=iAnz
ActiveWorkbook.Close savechanges:=False
Next iCounter
End If
End With
ERRORHANDLER:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Function FileArray(strPath As String, strPattern As String)
Dim arrDateien()
Dim intCounter As Integer
Dim strDatei As String
If Right(strPath, 1)  "\" Then strPath = strPath & "\"
strDatei = Dir(strPath & strPattern)
Do While strDatei  ""
intCounter = intCounter + 1
ReDim Preserve arrDateien(1 To intCounter)
arrDateien(intCounter) = strDatei
strDatei = Dir()
Loop
If intCounter = 0 Then
ReDim arrDateien(1)
arrDateien(1) = False
End If
FileArray = arrDateien
End Function
LG UweD
Anzeige
AW: Arbeitsblätter drucken
08.12.2021 17:02:33
berte
ok, sorry für meine Unwissenheit. Auf jeden Fall: jetzt klappt es, vielen Dank. Du bist der BESTE!
Gruß
berte
Danke für die Rückmeldung (owT)
09.12.2021 09:06:12
UweD

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige