AW: Seitenumbruch: Löschen von Seiten
16.08.2006 16:55:27
Seiten
Hallo Holger
eine Standard-Lösung kenne ich nicht. Folgende beiden Makros löschen entsprend der Bedingung für die Zelle in Spalte B alle leere Seiten bis zum Ende der Tabelle.
Das erste Makro funktioniert, wenn auf den Seiten schon irgendwelche Inhalte eingetragen sind.
Das 2. Makro funktioniert auch dann wenn nur die 13 manuellen Seitenwechsel gesetzt sind.
gruss
Franz
Sub Seitenwechselerkennen1()
Dim wks As Worksheet, Zeile As Long, LetzteZeile As Long
Set wks = ActiveSheet
LetzteZeile = wks.UsedRange.Row + wks.UsedRange.Rows.Count - 1
Zeile = 1
'1. leere Seite finden
Do Until IsEmpty(wks.Cells(Zeile, "B")) And wks.Rows(Zeile).PageBreak = xlPageBreakManual
Zeile = Zeile + 1
Loop
'Zeilen bis zum Tabellenende löschen
wks.Range(Rows(Zeile), Rows(LetzteZeile)).Delete
End Sub
Sub Seitenwechselerkennen2()
Dim wks As Worksheet, Zeile As Long, LetzteZeile As Long, Seite As Integer
Set wks = ActiveSheet
LetzteZeile = wks.UsedRange.Row + wks.UsedRange.Rows.Count - 1
Zeile = 1
Seite = 1
' 1. leere Seite finden
Do
If wks.Rows(Zeile).PageBreak = xlPageBreakManual Then Seite = Seite + 1
Zeile = Zeile + 1
Loop Until IsEmpty(wks.Cells(Zeile, "B")) And wks.Rows(Zeile).PageBreak = xlPageBreakManual
Seite = Seite + 1
' 14. Seite Finden
LetzteZeile = Zeile
Do Until Seite = 14 Or LetzteZeile = 1500 'Grenze für Zeilentahl ist Notausgang
LetzteZeile = LetzteZeile + 1
If wks.Rows(LetzteZeile).PageBreak = xlPageBreakManual Then Seite = Seite + 1
Loop
wks.Range(Rows(Zeile), Rows(Application.WorksheetFunction.Max(LetzteZeile, wks.UsedRange.Row _
+ wks.UsedRange.Rows.Count - 1))).Delete
End Sub