printarea aus zwei Bereichen erzeugen

17/08/2014 - 12:50 von Hans Alborg | Report spam
Hallo Gruppe,

<Excel 07>
für meine Printroutine markiere ich den Bereich einer großen Tabelle und
drücke dann einen Button.
Das erstellt ein Printarea des selektierten Bereichs und startet die
Druckvorschau.
Daraus starte ich dann den Ausdruck.

Alles prima soweit.

Nun fehlt mir aber der Tabellenkopf.
Daher habe ich in der Breite des selektierten Zellbereichs die Spalten
übernommen und möchte die Zeilen 1-8 davon mitdrucken.

Auch das klappt noch, aber!

Statt einer Seite (ist so eingestellt) werden zwei gedruckt. Sofern zwischen
Kopf und Selektion nicht mitgedruckte Bereiche liegen.

Ich hab die 2 Bereiche mit Union() verbunden.

Workaround wàre es, die beiden Bereiche auf ein Hilfsblatt untereinander zu
kopieren und dann erst als Printarea zu erfassen.
Najaaa.

Hier mal der komplette Code:
' --
Sub Druckbereich_wahl()
Dim rngKopf As Range
If Len(Selection.Address) < 6 Then Exit Sub

Set rngKopf = Range(Cells(1, Selection.Cells(Selection.Rows.Count, 1). _
End(xlUp).Column), Cells(8, Selection.Cells(Selection.Rows.Count, 1). _
End(xlUp).Column + Selection.Columns.Count - 1))

Set rngKopf = Union(rngKopf, Selection.Cells)
rngKopf.Select
With ActiveSheet.PageSetup
.PrintArea = Selection.Address
.Orientation = IIf(Selection.Width > Selection.Height, _
xlLandscape, xlPortrait)
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
.BlackAndWhite = True
End With
ActiveSheet.Range("B32").Select
ActiveWindow.SelectedSheets.PrintPreview
End Sub
' --
Geht das eleganter?

Auch meine Erfassung des Teils des Tabellenkopfes mit Gewinnung der Daten
aus dem selektierten Bereich kann sicher verbessert werden.

Hans
 

Lesen sie die antworten

#1 Claus Busch
17/08/2014 - 13:17 | Warnen spam
Hallo Hans,

Am Sun, 17 Aug 2014 12:50:41 +0200 schrieb Hans Alborg:

Statt einer Seite (ist so eingestellt) werden zwei gedruckt. Sofern zwischen
Kopf und Selektion nicht mitgedruckte Bereiche liegen.



das wirst du mit zwei Bereichen auch nicht àndern können. Da du aber
immer die oberen 8 Zeilen zusàtzlich haben möchtest, erklàre diese doch
zum Drucktitel (PrintTitleRows). Dann klappt es auch mit einer Seite:

Sub Druckbereich_wahl()

If Len(Selection.Address) < 6 Then Exit Sub

With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$8"
.PrintArea = Selection.Address
.Orientation = IIf(Selection.Width > Selection.Height, _
xlLandscape, xlPortrait)
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
.BlackAndWhite = True
End With
ActiveWindow.SelectedSheets.PrintPreview
End Sub

Was willst du mit Len(Selection.Address)<6 errreichen?
Das geht auch mit
Selection.cells.count = 1 then exit sub


Mit freundlichen Grüßen
Claus
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Ähnliche fragen