Seitenumbruch vor dem Drucken festlegen

Hallo zusammen
Folgendes will ich beim Ausdrucken der angehängten Datei automatisieren:
Vor jedem Ausdruck muss die Position des letzten Seitenumbruchs im aktiven Tabellenblatt überprüft werden. Dabei dürfen die letzten 7 Zeilen nicht unterbrochen werden, da in diesen Zeilen die Legende für die Tabelle enthalten ist. Das heisst: Das Makro muss vor dem Ausdrucken feststellen, ob sich der Letzte Umbruch nicht im Bereich der Legende (letzten 7 Zeilen) befindet (wie in Muster_Liste). Sollte sich der Umbruch im Bereich der Legende befinden, dann muss der Umbruch so nach oben verschoben werden, dass die Zeilen mit der Legende auf einer neuen Seite platziert werden. Wenn sich der letzte Umbruch nicht im Bereich der Legende befindet, können die vorgegebenen Standardumbrüche übernommen werden.
Ich habe das Forum nach einer ähnlichen Lösung durchsucht, bin aber leider nicht fündig geworden.
Vieleicht weiss jemand von euch, ob und wie ich die Aufgabe lösen kann.
Gruss
Stefan
Beispieldatei: https://www.herber.de/bbs/user/70954.xls

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Option Explicit Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim RowLegende With Sheets("Allgemeine Projekte") RowLegende = Application.Match("legende", .Columns(1), 0) If IsNumeric(RowLegende) Then .ResetAllPageBreaks .HPageBreaks.Add .Cells(RowLegende, 1) Else Cancel = True MsgBox "Legende nicht gefunden", vbExclamation End If End With End Sub

Hallo Stefan,
das folgende Makro prüft und setzt den manuellen Seitenwechsel vor dem Drucken. Das Makro muss unter "DieseArbeitsmappe" eingefügtwerden. Testen kannst du es mit der Seitenvorschau.
Gruß
Franz

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim LetzteZeile As Long
Select Case ActiveSheet.Name
Case "Allgemeine Projekte"
With Worksheets("Allgemeine Projekte")
LetzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
'ggf. vorhandenen manuellen Seitenwechsel vor Legende löschen
If .HPageBreaks(.HPageBreaks.Count).Type = xlPageBreakManual _
And .HPageBreaks(.HPageBreaks.Count).Location.Row = LetzteZeile - 6 Then
.HPageBreaks(.HPageBreaks.Count).Delete
End If
'ggf. manuellen Seitenwechsel vor Legende löschen
If .HPageBreaks(.HPageBreaks.Count).Location.Row > LetzteZeile - 6 Then
.HPageBreaks.Add .Cells(LetzteZeile - 6, 1)
End If
End With
Case Else
'do nothing
End Select
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim LetzteZeile As Long, wks As Worksheet Select Case ActiveSheet.Name Case "Allgemeine Projekte" Set wks = Worksheets("Allgemeine Projekte") With wks LetzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row 'Position letzter Seitenwechsel prüfen If .HPageBreaks(.HPageBreaks.Count).Location.Row >= LetzteZeile - 6 Then Application.ScreenUpdating = False 'Leerzeilen einfügen bis Legende auf Folgeseite Do .Rows(LetzteZeile - 6).Insert shift:=xlShiftDown LetzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row Loop Until .HPageBreaks(.HPageBreaks.Count).Location.Row

Beliebteste Forumthreads (12 Monate)

Seitenumbruch vor dem Drucken festlegen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread