Druckmakro
27.03.2008 16:42:00
Sascha
ich habe eine Datei, die ca 50 Arbeitsblätter umfasst, aus der ich immer einzelne Blätter drucken muss. Das ist mir soweit auch gelungen, der Code dazu sieht so aus:
Sub Druckauswahl()
Dim Zelle As Range, ws1 As Worksheet, wsReg As Worksheet, fehler%
On Error GoTo fehler
Set ws1 = Worksheets("Druckauswahl")
For Each Zelle In ws1.Range("B4:B8,I4:I15,I19:I30,N4:N15,N19:N30,S4:S15,S19:S30,X4:X15,X19: _
X30,AC4:AC15,AC19:Ac30,AH4:AH15,AH19:AH30,AM4:AM15,AR4:AR15")
If Zelle.Value > 0 Then
fehler = 1
Set wsReg = Worksheets(Zelle.Offset(0, 1).Value)
fehler = 0
With wsReg
'Titelzeilen festlegen (werden auf jeder Seite wiederholt)
.PageSetup.PrintTitleRows = .Range(.Rows(5), .Rows(5)).Address
'Druckbereich festlegen
'.PageSetup.PrintArea = .Range(.Cells(6, 2), _
.Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, 5)).Address
'.PageSetup.CenterHorizontally = True
End With
wsReg.PrintOut Copies:=Zelle.Value
' wsReg.PrintPreview
End If
NextBlatt:
Next
GoTo ende
fehler:
Select Case fehler
Case 1
MsgBox "Der Name des Tabellenblatts in Tabelle 1: " & Zelle.Offset(0, 1) _
& vbLf & " existiert nicht!"
Resume NextBlatt
Case Else
MsgBox "Fehler Nr. " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description
End Select
ende:
Set ws1 = Nothing: Set wsReg = Nothing: Set Zelle = Nothing
End Sub
Jetzt habe ich das Problem, dass die Blätter nacheinander gedruckt werden, am Besten wäre es aber, wenn alle gleichzeitig gedruckt werden, also der Befehl STRG und dann das entsprechende Blatt markieren und am Ende alles drucken, da ich einen PDF Printer verwende, der alles in eine Datei drucken soll. Danke für Eure Bemühungen
https://www.herber.de/bbs/user/51085.xls