Tabellen aus zwei Mappen drucken

Question

Hallo

ich habe zwei Arbeitsmappen mit mehreren Tabellen und möcht sie in einer
bestimmten Reihenfolge ausgedruckt haben.
Genau gesagt in Mappe 1 sind Tabellen die heißen 1,2,3,4, usw.
in Mappe zwei heißen die Tabellen a,b,c usw.

Die Reihenfolge soll jetzt nach dem Druck wie folgt aussehen

1, a, 2 ,b ,3, c, 4, d usw.
Also Tabelle 1 aus Mappe 1, Tabelle 1 aus Mappe 2,Tabelle 2 aus Mappe 1, Tabelle 2
aus Mappe 2 usw.

Answer 1

Hallo nochmal


Du hast das Thema sehr gut verstanden, es stimmt die Dateien sind immer die gleichen nur der Inhalt ändert sich. Sie liegen in
Netzwerken und werden von verschiedenen Personen ausgedruckt.
Wenn es möglich ist ,dann könnte man sich die Auswahldialoge wirklich sparen, und die beiden Dateien fest im Code
hinterlegen.
Vieleicht kannst du mir den Code so ändern das ich den Speicherort im Code hinterlegen kann.

danke im Vorraus

Erwin

Answer 2

Moin,

Ich habe das mal entsprechend umgebaut. Da der Pfad zur Datei nun fest im Code hinterlegt ist,
musst Du allerdings sicherstellen, dass die Dateien auch auf ALLEN beteiligten Rechnern unter
diesem Pfad erreichbar sind. Da Du nun etwas von Netzwerk schreibst, heisst das, dass das Ziel-
verzeichniss auf allen Rechnern auf den selben Laufwerksbuchstaben gemappt werden muss.
Oder Du traegst statt dem Laufwerksbuchstaben des Netzlaufwerkes den entsprechenden UNC-Pfad
in den Code ein.
(also nicht LW:\Verzeichnis\Unterverzeichnis\Datei.xyz ,
sondern \\RechnerName\FreigabeName\Unterverzeichnis\Datei.xyz )
btw: Letzteres halte ich fuer die bessere Loesung.

Zusaetzlich habe ich noch eine Pruefung eingebaut, ob die Dateien vorhanden sind. (Fuer den Fall,
dass das Makro gestartet wird, wenn der Rechner nicht im Netzwerk haengt. z.B.)

Teste also mal folgenden Code:

Sub MappenDruck()
'Konstantenbeschreibung
'Pfad zu den Dateien hier anpasen!!!
'===================================
'Version mit lokalem Pfad
'Const strPathFF As String = "X:\001_Test\Excel-Tests\Drucken von 2 Mappen\123.xlsx"
'Const strPathSF As String = "X:\001_Test\Excel-Tests\Drucken von 2 Mappen\abc.xlsx"
'Version mit UNC-Pfadangabe
Const strPathFF As String = "\\Pentium\Wkz\ExcelTestNetzwerk\123.xlsx"
Const strPathSF As String = "\\Pentium\Wkz\ExcelTestNetzwerk\abc.xlsx"

'VariablenDefinition
'===================
Dim strInput As String
Dim wbFF As Workbook, wbSF As Workbook, wbPrint As Workbook
Dim intMaxWS As Integer, intCounter As Integer
Dim varArr As Variant
Dim blnFE As Boolean

'Pruefung ob die Dateien existieren/erreichbar sind
'==================================================
blnFE = True
If Dir(strPathFF) = "" Then blnFE = False
If Dir(strPathSF) = "" Then blnFE = False
If Not blnFE Then MsgBox "Mindestens eine der zu durckenden " & vbCrLf & _
"Dateien ist nicht ""verfuegbar""." & vbCrLf & vbCrLf & "Drucken wird abgebrochen!", _
vbOKOnly + vbCritical, "Fehler": End

'zu druckenden Namen abfragen (wenn keine Vorbelegung gewuenscht, dann
'einfach "mein Vorname" durch "" ersetzen)
'=====================================================================
strInput = InputBox("Bitte geben Sie hier den in ""C4""" & vbCrLf & _
"zu druckenden Vornamen/Text ein.", "Eingabe", "mein Vorname")

'Rueckfrage bei leerem String (Loeschen der InputBox oder Abbruch)
'=================================================================
If strInput = "" Then If MsgBox("Die Eingabe des Namens wurde abgebrochen, " & vbCrLf & _
"oder es wurde kein Text eingeben. " & vbCrLf & vbCrLf & _
"Soll die Zusammenfassung" & vbCrLf & _
"ohne Namen gedruckt werden?" & vbCrLf & vbCrLf & _
"Ja = ohne Namen drucken" & vbCrLf & _
"Nein = nicht drucken", _
vbYesNo + vbDefaultButton2 + vbQuestion, "Rueckfrage") = vbNo Then End


'Mappen zusammenfuehren
'======================
Set wbPrint = Workbooks.Add(xlWBATWorksheet) 'Druckmappe fuer die Zusammenfassung
Set wbFF = Workbooks.Open(strPathFF) 'erste zu druckende Mappe oeffnen
Set wbSF = Workbooks.Open(strPathSF) 'zweite zu druckende Mappe oeffnen
intMaxWS = wbFF.Sheets.Count 'SheetZahl von erster Mappe
If wbSF.Sheets.Count < wbFF.Sheets.Count Then intMaxWS = wbSF.Sheets.Count 'intMaxWS auf kleinste SheetZahl
For intCounter = 1 To intMaxWS Step 1 'Sheets in Zusammenfassung kopieren
wbFF.Sheets(intCounter).Copy After:=wbPrint.Sheets(wbPrint.Sheets.Count)
wbSF.Sheets(intCounter).Copy After:=wbPrint.Sheets(wbPrint.Sheets.Count)
Next intCounter
ReDim varArr(2 To wbPrint.Sheets.Count) 'Array fuer Namen derzu druckenden Sheets
For intCounter = 2 To wbPrint.Sheets.Count 'Sheets durchlaufen (2 bis Ende)
varArr(intCounter) = wbPrint.Sheets(intCounter).Name 'SheetNamen aufsammeln
If wbPrint.Sheets(intCounter).Type = xlWorksheet Then _
wbPrint.Sheets(intCounter).Range("C4").Value = strInput 'zu druckenden Namen schreiben
Next intCounter
wbPrint.Sheets(varArr).PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False 'Drucken

'Alle Mappen schliessen (OHNE SPEICHERN)
'======================================
wbFF.Close False
wbSF.Close False
wbPrint.Close False

'Objecte zerstoeren
'==================
Set wbPrint = Nothing
Set wbFF = Nothing
Set wbSF = Nothing

End Sub

Cu TheBlackBird ®

Answer 3

Moin,

Ups... die Pruefung wenn der Rechner (auf den der UNC-Pfad zeigt) nicht im Netz
ist, funktioniert so noch nicht wirklich, wie ich gerade gemerkt habe. Da muss
ich wohl noch mal nachbessern. ;-)

Cu TheBlackBird ®

Answer 4

Moin,

Pruefung nochmal ueberarbeitet und in eine Function ausgelagert. Ersetze also das Sub MappenDruck und fuege die Privat Function mit in das Modul ein.

Sub MappenDruck()
'Konstantenbeschreibung
'Pfad zu den Dateien hier anpassen!!!
'===================================
'Version mit lokalem Pfad
' Const strPathFF As String = "C:\001_Test\Excel-Tests\Drucken von 2 Mappen\123.xlsx"
' Const strPathSF As String = "C:\001_Test\Excel-Tests\Drucken von 2 Mappen\abc.xlsx"
'Version mit UNC-Pfadangabe
Const strPathFF As String = "\\Pentium\Wkz\ExcelTestNetzwerk\123.xlsx"
Const strPathSF As String = "\\Pentium\Wkz\ExcelTestNetzwerk\abc.xlsx"

'VariablenDefinition
'===================
Dim strInput As String
Dim wbFF As Workbook, wbSF As Workbook, wbPrint As Workbook
Dim intMaxWS As Integer, intCounter As Integer
Dim varArr As Variant
Dim blnFE As Boolean

'Pruefung ob die Dateien existieren/erreichbar sind
'==================================================
blnFE = p_ufFExist(strPathFF) And p_ufFExist(strPathSF)

If Not blnFE Then MsgBox "Mindestens eine der zu druckenden " & vbCrLf & _
"Dateien ist nicht ""verfuegbar""." & vbCrLf & vbCrLf & "Drucken wird abgebrochen!", _
vbOKOnly + vbCritical, "Fehler": End

'zu druckenden Namen abfragen (wenn keine Vorbelegung gewuenscht, dann
'einfach "mein Vorname" durch "" ersetzen)
'=====================================================================
strInput = InputBox("Bitte geben Sie hier den in ""C4""" & vbCrLf & _
"zu druckenden Vornamen/Text ein.", "Eingabe", "mein Vorname")

'Rueckfrage bei leerem String (Loeschen der InputBox oder Abbruch)
'=================================================================
If strInput = "" Then If MsgBox("Die Eingabe des Namens wurde abgebrochen, " & vbCrLf & _
"oder es wurde kein Text eingeben. " & vbCrLf & vbCrLf & _
"Soll die Zusammenfassung" & vbCrLf & _
"ohne Namen gedruckt werden?" & vbCrLf & vbCrLf & _
"Ja = ohne Namen drucken" & vbCrLf & _
"Nein = nicht drucken", _
vbYesNo + vbDefaultButton2 + vbQuestion, "Rueckfrage") = vbNo Then End


'Mappen zusammenfuehren
'======================
Set wbPrint = Workbooks.Add(xlWBATWorksheet) 'Druckmappe fuer die Zusammenfassung
Set wbFF = Workbooks.Open(strPathFF) 'erste zu druckende Mappe oeffnen
Set wbSF = Workbooks.Open(strPathSF) 'zweite zu druckende Mappe oeffnen
intMaxWS = wbFF.Sheets.Count 'SheetZahl von erster Mappe
If wbSF.Sheets.Count < wbFF.Sheets.Count Then intMaxWS = wbSF.Sheets.Count 'intMaxWS auf kleinste SheetZahl
For intCounter = 1 To intMaxWS Step 1 'Sheets in Zusammenfassung kopieren
wbFF.Sheets(intCounter).Copy After:=wbPrint.Sheets(wbPrint.Sheets.Count)
wbSF.Sheets(intCounter).Copy After:=wbPrint.Sheets(wbPrint.Sheets.Count)
Next intCounter
ReDim varArr(2 To wbPrint.Sheets.Count) 'Array fuer Namen derzu druckenden Sheets
For intCounter = 2 To wbPrint.Sheets.Count 'Sheets durchlaufen (2 bis Ende)
varArr(intCounter) = wbPrint.Sheets(intCounter).Name 'SheetNamen aufsammeln
If wbPrint.Sheets(intCounter).Type = xlWorksheet Then _
wbPrint.Sheets(intCounter).Range("C4").Value = strInput 'zu druckenden Namen schreiben
Next intCounter
wbPrint.Sheets(varArr).PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False 'Drucken

'Alle Mappen schliessen (OHNE SPEICHERN)
'======================================
wbFF.Close False
wbSF.Close False
wbPrint.Close False

'Objecte zerstoeren
'==================
Set wbPrint = Nothing
Set wbFF = Nothing
Set wbSF = Nothing

End Sub

Private Function p_ufFExist(ByVal strPath As String) As Boolean
On Error GoTo ErrHandler
If Dir(strPath) <> "" Then p_ufFExist = True
On Error GoTo 0
Exit Function
ErrHandler:
On Error GoTo 0
End Function

Dann sollte die Pruefung auch dann funktionieren, wenn der UNC-Pfad ueberhaupt nicht erreichbar ist. (In der alten Version trat dann ein Laufzeitfehler auf.)

Cu TheBlackBird ®

Answer 5

Moin TheBlackBird ®

alles funktioniert einwandfrei.
Ist für mich immer wieder beeindruckend was manche Leute drauf haben.

vielen Dank nochmal


Gruß Erwin