Makro zum Drucken mehrerer Tabellenblätter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Druck() Dim Rng As Range, objCell As Range, wsSheet As Worksheet On Error Resume Next Set Rng = Worksheets("Tabelle1").Range("B4:B70").SpecialCells(xlCellTypeConstants) On Error GoTo 0 If Rng Is Nothing Then Exit Sub For Each objCell In Rng On Error Resume Next Set wsSheet = Worksheets(objCell.Text) On Error GoTo 0 If Not wsSheet Is Nothing Then wsSheet.Range("A2:I250").PrintOut Copies:=1, Collate:=True Set wsSheet = Nothing End If Next End Sub

Hallo Gerd,
danke für Deine schnelle Antwort. Ich habe Deinen Code in ein ActiveX-Button eingebettet. Vorsichtshalber habe ich meinen Standarddrucker auf den XPS-Writer umgestellt, damit nicht jedes mal zig Seiten gedruckt werden. Das Makro läuft ab, jedoch erhalte ich keine Rückmeldung, das "Speichern unter..." Fenster erscheint jedoch auch nicht.
Wenn ich das richtig sehe steht in Deinem Makro, dass bei Fehler nix geschehen soll. Ich befürchte, dass bei dem Makro immer ein Fehler auftritt und deswegen nix passiert.
Meine VBA-Kenntnisse scheitern jedoch schon daran, Displays einzubauen um zu sehen, wie weit das Makro kommt.
Kannst Du mir weiterhelfen?
Hier der Code:

Private Sub CommandButton1_Click()
Dim Rng As Range, objCell As Range, wsSheet As Worksheet
On Error Resume Next
Set Rng = Worksheets("Tabelle1").Range("B4:B70").SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Rng Is Nothing Then Exit Sub
For Each objCell In Rng
On Error Resume Next
Set wsSheet = Worksheets(objCell.Text)
On Error GoTo 0
If Not wsSheet Is Nothing Then
wsSheet.Range("A2:I250").PrintOut Copies:=1, Collate:=True
Set wsSheet = Nothing
End If
Next
End Sub

Sub test() Dim Zelle As Range Dim strGedruckt As String Dim strNichtGefunden As String Dim ws As Worksheet For Each Zelle In Range("B4:B70") If Zelle.Value "" Then Set ws = Nothing On Error Resume Next Set ws = Worksheets(Zelle.Text) On Error GoTo 0 If ws Is Nothing Then strNichtGefunden = strNichtGefunden & vbLf & Zelle.Text Else strGedruckt = strGedruckt & vbLf & Zelle.Text ws.Range("A2:I250").PrintOut End If End If Next MsgBox "Gedruckt wurden: " & strGedruckt & vbLf & vbLf & "nicht gefunden wurden:" & _ strNichtGefunden End Sub

Beliebteste Forumthreads (12 Monate)

Makro zum Drucken mehrerer Tabellenblätter

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

294 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro zum Drucken mehrerer Tabellenblätter

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

294 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread