mit VBA mehrere Tabellenblätter drucken

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Test() With ThisWorkbook.Worksheets("A").PageSetup .Zoom = False .PrintArea = "$A$6:$L$25" .Orientation = xlPortrait .Zoom = 75 .CenterHeader = "&""Comic Sans MS""&16""&I" & "Inventurwerte - A""" End With With ThisWorkbook.Worksheets("B").PageSetup .Zoom = False .PrintArea = "$A$6:$O$76" .Orientation = xlPortrait .Zoom = 78 .CenterHeader = "&""Comic Sans MS""&16""&I" & "Inventurwerte - B""" End With 'zu druckende Blätter gruppieren ThisWorkbook.Sheets(Array("A", "B")).Select Application.Dialogs(xlDialogPrint).Show 'Gruppierung wieder aufheben ThisWorkbook.Sheets("A").Select End Sub

Hi Franz,
super, es funktioniert einwandfrei! Danke!
Wie kann ich noch folgenden Zusatz für jedes Tabellenblatt mit einbringen?
'Rahmenlinie einfügen
Range("L9:L211").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
Hier kommt der Druckbefehl rein, davor wird eine Rahmenlinie gesetzt, die danach wieder "entfernt" bzw. durch eine andere Rahmenlinie ausgetauscht wird.
'Rahmenlinie Entfernen, und reguläre Rahmenlinien einfügen
Range("L9:L211").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With

Hallo Dominic,
wenn die Rahmen immer in der gleichen Weise formatiert werden und sich nur der Bereich auf den einzelnen Blättern ändert, dann kann man es wie folgt lösen. Die Formatierung erfolgt in einer Unterroutine, der der zu formatierende Bereich als Parameter übergeben wird.
Gruß
Franz

Sub Test()
Application.ScreenUpdating = False
With ThisWorkbook
With .Worksheets("A")
Call prcRahmenSetzen(rngBereich:=.Range("L9:L211")) 'Bereich anpassen !
With .PageSetup
.Zoom = False
.PrintArea = "$A$6:$L$25"
.Orientation = xlPortrait
.Zoom = 75
.CenterHeader = "&""Comic Sans MS""&16""&I" & "Inventurwerte - A"""
End With
End With
With .Worksheets("B")
Call prcRahmenSetzen(rngBereich:=.Range("O9:O76")) 'Bereich anpassen !
With .PageSetup
.Zoom = False
.PrintArea = "$A$6:$O$76"
.Orientation = xlPortrait
.Zoom = 78
.CenterHeader = "&""Comic Sans MS""&16""&I" & "Inventurwerte - B"""
End With
End With
End With
Application.ScreenUpdating = True
'zu druckende Blätter gruppieren
ThisWorkbook.Sheets(Array("A", "B")).Select
Application.Dialogs(xlDialogPrint).Show
'Gruppierung wieder aufheben
ThisWorkbook.Sheets("A").Select
'Rahmenlinie Entfernen, und reguläre wieder Rahmenlinien einfügen
'hier müssen dann bei den einzelnen Blättern die gleichen Bereiche _
eingetragen werden wie beim Setzen der Rahmen
Application.ScreenUpdating = False
With ThisWorkbook
Call prcRahmenZurueckSetzen(rngBereich:=.Sheets("A").Range("L9:L211"))
Call prcRahmenZurueckSetzen(rngBereich:=.Sheets("B").Range("O9:O76"))
'hier dann für die anderen Blätter Zeilen kopieren/anpassen
End With
Application.ScreenUpdating = True
End Sub
Sub prcRahmenSetzen(rngBereich As Range)
'Rahmen im Zellbereich vor dem Drucken formatieren
'Rahmenlinie einfügen
With rngBereich
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
End With
End Sub
Sub prcRahmenZurueckSetzen(rngBereich As Range)
'Rahmen im Zellbereich nach dem Drucken formatieren
'Rahmenlinie Entfernen, und reguläre Rahmenlinien einfügen
With rngBereich
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
.Borders(xlInsideVertical).LineStyle = xlNone
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
End With
End Sub

Beliebteste Forumthreads (12 Monate)

mit VBA mehrere Tabellenblätter drucken

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

30 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

mit VBA mehrere Tabellenblätter drucken

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

30 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread