Drucken ohne Select oder aktivate

Hallo zusammen
Ich habe in einem Projekt meherer Tabellen auszudrucken.
Für jede Tabelle gelten andere Bedingungen (dynamischer Druckbereich, Seiteneinstellung usw)
Auf grund meines eingeschränkten Verständnisses für manche Dinge habe ich der Einfachheit halber mit select oder activate gearbeitet. Das ist aber ein fürchterliches geflimmer auf dem Bildschirm wenn beim Druckvorgang immer zwischen den Tabellen gezappt wird.
Wie kann ich das im Hintergrund laufen lassen? Vielleicht habe ich ja hier einen Fall, wo man auf select oder aktivate nicht verzichten kann. Ich habe jetzt schon so Manches ausprobiert, aber bei der ganzen indirekten Zuweisungen von Werten und Objekten beiße ich mir die Zähne aus.
Vielleicht kann mir jemand sagen wie es einfacher geht. Oder ein kleiner Tip an einer entscheidenen Stelle.
Anbei der Code um den es geht. Ich habe jetzt mal alles komplett reingesetzt. Jedes einzelne Druckmodul ist nicht wichtig. Es geht dabei immer um Druckparameter festlegen; (teilweise Pivottabellen aktualisieren); Seite einrichten und ausdrucken.
Aber ich möchte so wie es gebraucht wird, im Hintergrund haben.
Ach so: Es ist noch wichtig zu wissen, dass die Tabellen vorher durch xlVeryHidden in der Regel ausgebelendet sind.
Danke schon mal.
Public gruppendruck As Boolean
Public druckabbruch As Boolean
'###########################################################################################
' Drucken
'###########################################################################################
'***********************************************************************************
'Startseite / Deckblatt Drucken
'***********************************************************************************


Sub StartSeitenDruck()
With Worksheets("Start")
.Visible = True
.Select
End With
ActiveSheet.ScrollArea = ""
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Dim rng As Range
Set rng = Range(Cells(1, 1), _
Cells(Cells(63, 4).End(xlUp).Row, 4))
ActiveSheet.ScrollArea = rng.Address
ActiveSheet.PageSetup.PrintArea = rng.Address
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Dim ReturnValue
ReturnValue = Application.Dialogs(xlDialogPrint).Show
If ReturnValue = False Then
GoTo DruckAbbrechen
End If
Exit Sub
DruckAbbrechen:
druckabbruch = True
Call Zurueck
Application.ScreenUpdating = True
End Sub

'***********************************************************************************
'Materialauswertung Drucken
'***********************************************************************************


Sub MaterialDrucken()
On Error Resume Next
Application.ScreenUpdating = False
With Worksheets("Auswertung")
.Visible = True
.Select
End With
ActiveSheet.Columns.Hidden = False
ActiveSheet.ScrollArea = ""
Range("E2:M2").Select
ActiveWindow.Zoom = 100
ActiveWindow.Zoom = True
ActiveSheet.PivotTables("PivotTable2").RefreshTable
s = Range(Cells(6, 6), Cells(6, Columns.Count)).End(xlToRight).Column
Dim rng As Range
Set rng = Range(Cells(1, 6), _
Cells(Cells(Rows.Count, s).End(xlUp).Row, s))
ActiveSheet.ScrollArea = rng.Address
ActiveSheet.PageSetup.PrintArea = rng.Address
With ActiveSheet.PageSetup
.PrintTitleRows = "$4:$6"
.PrintTitleColumns = ""
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
If gruppendruck = False Then
ActiveSheet.PrintPreview
Else
ActiveWindow.SelectedSheets.PrintOut
End If
Application.ScreenUpdating = True
On Error GoTo 0
Call Zurueck
End Sub

'***********************************************************************************
'Fertigung Auswertung Drucken
'***********************************************************************************


Sub AuswertungFertigungDrucken()
Application.ScreenUpdating = False
With Worksheets("Auswertung")
.Visible = True
.Select
End With
ActiveSheet.Columns.Hidden = False
ActiveSheet.ScrollArea = ""
Range("BD2:BM2").Select
ActiveWindow.Zoom = 100
ActiveWindow.Zoom = True
ActiveSheet.PivotTables("PivotTable1").RefreshTable
s = Range(Cells(6, 57), Cells(57, Columns.Count)).End(xlToRight).Column
Dim rng As Range
Set rng = Range(Cells(1, 57), _
Cells(Cells(Rows.Count, s).End(xlUp).Row, s))
ActiveSheet.ScrollArea = rng.Address
ActiveSheet.PageSetup.PrintArea = rng.Address
With ActiveSheet.PageSetup
.PrintTitleRows = "$4:$6"
.PrintTitleColumns = ""
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
If gruppendruck = False Then
ActiveSheet.PrintPreview
Else
ActiveWindow.SelectedSheets.PrintOut
End If
Application.ScreenUpdating = True
Call Zurueck
End Sub

'***********************************************************************************
'Summenblatt Drucken
'***********************************************************************************


Sub AuswertungGesamtDrucken()
Application.ScreenUpdating = False
With Worksheets("Auswertung")
.Visible = True
.Select
End With
ActiveSheet.Columns.Hidden = False
Deckblattsperre_aufheben = False
Range("CP1:CX1").Select
ActiveWindow.Zoom = 100
ActiveWindow.Zoom = True
Deckblattsperre_aufheben = True
ActiveSheet.PivotTables("PivotTable1").RefreshTable
ActiveSheet.PivotTables("PivotTable2").RefreshTable
ActiveSheet.PivotTables("PivotTable5").RefreshTable
ActiveSheet.PivotTables("PivotTable6").RefreshTable
ActiveSheet.PivotTables("PivotTable3").RefreshTable
ActiveSheet.PivotTables("PivotTable4").RefreshTable
Dim rng As Range
Set rng = Range(Cells(1, 95), _
Cells(Cells(500, 101).End(xlUp).Row, 101))
ActiveSheet.PageSetup.PrintArea = rng.Address
With ActiveSheet.PageSetup
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
If gruppendruck = False Then
ActiveSheet.PrintPreview
Else
ActiveWindow.SelectedSheets.PrintOut
End If
Application.ScreenUpdating = True
Call Zurueck
End Sub

'***********************************************************************************
'Material & Fertigung Drucken
'***********************************************************************************


Sub PositionKostenDrucken()
Application.ScreenUpdating = False
On Error Resume Next
With Worksheets("Auswertung")
.Visible = True
.Select
End With
ActiveSheet.Columns.Hidden = False
ActiveSheet.ScrollArea = ""
Range("CA2:CL2").Select
ActiveWindow.Zoom = 100
ActiveWindow.Zoom = True
ActiveSheet.PivotTables("PivotTable1").RefreshTable
ActiveSheet.PivotTables("PivotTable2").RefreshTable
ActiveSheet.PivotTables("PivotTable7").RefreshTable
Call PivotFormat
s = Range(Cells(6, 80), Cells(80, Columns.Count)).End(xlToRight).Column
Dim rng As Range
Set rng = Range(Cells(1, 80), _
Cells(Cells(Rows.Count, s).End(xlUp).Row, s))
ActiveSheet.ScrollArea = rng.Address
ActiveSheet.PageSetup.PrintArea = rng.Address
With ActiveSheet.PageSetup
.PrintTitleRows = "$4:$6"
.PrintTitleColumns = ""
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
If gruppendruck = False Then
ActiveSheet.PrintPreview
Else
ActiveWindow.SelectedSheets.PrintOut
End If
Application.ScreenUpdating = True
On Error GoTo 0
Call Zurueck
End Sub

'***********************************************************************************
'Eingabeliste drucken
'***********************************************************************************


Sub DetailkalkulationDrucken()
Application.ScreenUpdating = False
With Worksheets("Erfassen")
.Visible = True
.Select
.PageSetup.RightHeader = "Seite &P von &N"
.PageSetup.CenterHeader = "Angebot Nr:  " & Worksheets("Start").Range("B9")
End With
Dim rng1 As String
rng1 = ActiveSheet.ScrollArea
ActiveSheet.ScrollArea = ""
Dim rng4 As Range
Set rng4 = Range(Cells(3, 3), _
Cells(Cells(Rows.Count, 5).End(xlUp).Row + 5, 13))
ActiveSheet.PageSetup.PrintArea = rng4.Address
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
ActiveSheet.ScrollArea = rng1
If gruppendruck = False Then
ActiveSheet.PrintPreview
Else
ActiveWindow.SelectedSheets.PrintOut
End If
Application.ScreenUpdating = True
Call Zurueck
End Sub

'***********************************************************************************
'Kabelliste drucken
'***********************************************************************************


Sub KabellisteDrucken()
Application.ScreenUpdating = False
With Worksheets("Kabelübersicht")
.Visible = True
.Select
.PageSetup.RightHeader = "Seite &P von &N"
.PageSetup.CenterHeader = "Kabel-Stammliste  "
End With
'Dim rng1 As String
'rng1 = ActiveSheet.ScrollArea
'      ActiveSheet.ScrollArea = ""
Dim rng4 As Range
Set rng4 = Range(Cells(9, 1), _
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 5, 6))
ActiveSheet.PageSetup.PrintArea = rng4.Address
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
'   ActiveSheet.ScrollArea = rng1
ActiveSheet.PrintPreview
Application.ScreenUpdating = True
Call Zurueck
End Sub

'###########################################################################################
' Kompletter Ausdruck
'###########################################################################################


Sub AllesDrucken()
druckabbruch = False
gruppendruck = True
If druckabbruch = True Then GoTo ende
StartSeitenDruck
If druckabbruch = True Then GoTo ende
AuswertungGesamtDrucken
If druckabbruch = True Then GoTo ende
DetailkalkulationDrucken
If druckabbruch = True Then GoTo ende
PositionKostenDrucken
If druckabbruch = True Then GoTo ende
MaterialDrucken
If druckabbruch = True Then GoTo ende
AuswertungFertigungDrucken
ende:
gruppendruck = False
End Sub

'###########################################################################################
' Standardausdruck
'###########################################################################################


Sub Drucken_Standard()
druckabbruch = False
gruppendruck = True
If druckabbruch = True Then GoTo ende
StartSeitenDruck
If druckabbruch = True Then GoTo ende
AuswertungGesamtDrucken
If druckabbruch = True Then GoTo ende
DetailkalkulationDrucken
ende:
gruppendruck = False
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Test() Dim wsh As Worksheet Set wsh = ThisWorkbook.Worksheets("Tabelle1") Dim rng As Range Set rng = wsh.Range(Cells(1, 95), _ Cells(Cells(500, 101).End(xlUp).Row, 101)) With wsh .PageSetup.PrintArea = rng.Address End With End Sub

Hallo Christian
Das ist genau das Ergebnis welches ich auch bekomme. Aber das ist leider falsch. Weil die Tabellle "Auswertung" nicht die aktive Tabelle ist. Ich möchte, und das ist der Punkt, den Druckbereich auf eine andere Tabelle refernzieren, ohne diese zu aktivieren.
Vielleicht ist die "With" Variante dafür nicht geeignet. Ich weiß es eben nicht. Wie refenziere ich einen Druckbereich für eine nicht aktive Tabelle, der aber nicht statisch sondern vom dynamischen Zustand dieser Tabelle abhängig ist.
Im Grunde möchte ich folgendes erreichen. Druckauftrag 1 aufrufen, Parameter festlegen, Ausdruck.... Druckauftrag 2 aufrufen, Parameter festlegen, ausdruck....... usw. Es werden also mehrere Druckmodule hintereinander per VBA aufgerufen. Und das alles ohne, dass ich am Bildschirm davon etwas mitbekommen möchte.Leider sind die einzelnen Druckmodule mit unterschiedlichen Tabellen verbunden, die ich im Moment noch selectiere um die Druckparameter festzulegen. Und das führt zu dieser Unruhe auf dem Bildschirm.

Sub Test() Dim wsh As Worksheet Dim wsh2 As Worksheet Dim rng As Range Dim nlastrow As Integer, nlastcol Set wsh = ThisWorkbook.Worksheets("Tabelle1") Set wsh2 = ThisWorkbook.Worksheets("Tabelle2") nlastrow = FUNC_LastRow(wsh2) nlastcol = FUNC_LastCol(wsh2) Set rng = wsh2.Range(Cells(1, 1), Cells(nlastrow, nlastcol)) With wsh .PageSetup.PrintArea = rng.Address End With End Sub

Function FUNC_LastRow(WS As Worksheet) FUNC_LastRow = WS.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row End Function

Function FUNC_LastCol(WS As Worksheet) FUNC_LastCol = WS.Cells.Find(What:="*", After:=WS.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, _ SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column End Function

Beliebteste Forumthreads (12 Monate)

Drucken ohne Select oder aktivate

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread