AW: Problem bei Seitenansicht & Umbruch
14.07.2006 23:45:00
fcs
Hallo Lara,
Das Problem Nr. 1 ist bei mir nicht aufgetreten
zu Problem Nr. 2
Dadurch, dass du in der Mustervorlage den manuellen Seitenwechsel gesetzt hast, können natürlich beim Einfügen weiterer Zeilen unvollständig ausgefüllte Seiten entstehen.
Du muss also nach jedem Einfügen von neuen Zeilen oder vor dem Drucken/Seitenvorschau die manuellen Seitenwechsel löschen und ggf. einen neuen Seitenwechsel setzen, damit die Folgeseite immer mit einer Überschriftenzeile beginnt.
Nachfolgendes Makro erledigt das. Es prüft nach dem Löschen aller manuellen Seitenwechsel , ob die automatischen Seitenwechsel oberhalb einer als Überschrift formatierten Zeile (graue Zellfüllfarbe) liegt und berücksichtigt dabei 1- und 2-zeilige Überschriften.
Da die Laufzeit des Makros relativ lang ist, sollte man das Makro nur vor dem Drucken ausführen mit:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Call Seitenwechsel
End Sub
oder nur manuell per Button starten
gruss Franz
Sub Seitenwechsel()
Dim wks As Worksheet, Zeile1 As Long, Zeile2 As Long
Set wks = ActiveSheet
'vorhandene manuelle Seitenwechsel löschen
wks.Cells.EntireRow.PageBreak = xlPageBreakNone
' Seitenwechsel prüfen, ggf. manuellen Wechsel einfügen
Zeile1 = 18
With wks
Do
If .Cells(Zeile1, "A").EntireRow.PageBreak = xlPageBreakAutomatic Then
If .Cells(Zeile1, "A").Interior.ColorIndex = xlColorIndexNone Then 'Zeile ist keine Überschrift
Zeile2 = Zeile1 - 1
'Zeilen oberhalb prüfen bis Zeile grau formatiert (Überschrift)
Do Until .Cells(Zeile2, "A").Interior.ColorIndex = 15 'Zeile ist Überschrift
Zeile2 = Zeile2 - 1
Loop
If .Cells(Zeile2 - 1, "A").Interior.ColorIndex = xlColorIndexNone Then 'Einzeilige Überschrift
.Cells(Zeile2, "A").EntireRow.PageBreak = xlPageBreakManual
Else 'Zweizeilige Überschrift
.Cells(Zeile2 - 1, "A").EntireRow.PageBreak = xlPageBreakManual
End If
Else
If .Cells(Zeile1 - 1, "A").Interior.ColorIndex = xlColorIndexNone Then
'do nothing, automatischer Seitenumbruch ist oberhalb einer Überschriftszeile
Else
.Cells(Zeile1 - 1, "A").EntireRow.PageBreak = xlPageBreakManual
End If
End If
End If
Zeile1 = Zeile1 + 1
If Zeile1 > .UsedRange.Row + .UsedRange.Rows.Count Then Exit Do 'Notausgang
Loop Until Left(.Cells(Zeile1 - 1, "A"), 24) = "*) Zusätzliche Aktivität"
End With
End Sub