AW: Seitenumbruch einbauen
09.03.2008 02:25:00
fcs
Hallo Gesa,
leider kann ich mit meinem veralteten Excel dein passwortgeschütztes VBA-Projekt nicht öffnen.
Im Prinzip kann man mit folgenden Prozeduren verhindern, dass ein bestimmter Zeilenbereich durch einen automatischen Seitenwechsel geteilt wird.
Da bei dir die Zeilenummern sich ständig ändern können, muss der Zeilenbereich jeweils vorher gesucht werden.
Die Prozedur TestSeitenwechsel muss du in deiner Druckprozedur aufrufen entweder nach dem Festlegen des Druckbereichs bzw. unmittelbar vor dem Druckbefehl mit
Call TestSeitenwechsel
Das Makro ist relativ langsam. Bei der schnelleren direkten Abfrage der Seitenwechselpositionen gab es bei mir mit Excel97 leider Probleme, so dass ich den Umweg über die Prüfung der einzelnen Zeilen wählen musste.
Gruß
Franz
Sub TestSeitenwechsel()
Dim ws As Worksheet, Zeile1 As Long, Zeile2 As Long
Set ws = ActiveSheet
With ws
'In Spalte E bestimmte Einträge suchen
Zeile2 = .Cells(.Rows.Count, 5).End(xlUp).Row
'Zeile mit Eintrag "Zusatzinformation für PersAbtlg.:" suchen
Do Until .Cells(Zeile2, 5).Value = "Zusatzinformation für PersAbtlg.:"
Zeile2 = Zeile2 - 1
Loop
Zeile2 = Zeile2 + 1
'Zeile mit Eintrag "Ohne Kostenstelle" suchen
Zeile1 = Zeile2
Do Until .Cells(Zeile1, 5).Value = "Ohne Kostenstelle"
Zeile1 = Zeile1 - 1
Loop
End With
Zeile1 = Zeile1 - 1
ws.Unprotect password:="1234"
'ggf. vorhandene manuelle Seitenwechsel im Bereich löschen
Call SeitenwechselLoeschen(ws, 14, Zeile2)
'Prüfen ob Seitenwechsel im Zeilenbereich
If CheckSeitenwechsel(ws, Zeile1, Zeile2) = True Then
'Seitenwechsel vor Zeile1 einfügen
ws.Rows(Zeile1).PageBreak = xlPageBreakManual
End If
ws.Protect password:="1234"
End Sub
Function CheckSeitenwechsel(ws As Worksheet, Zeile1 As Long, Zeile2 As Long) As Boolean
'Prüfung ob im Zeilenbereich automatische horizontale Seitenwechsel vorhanden
Dim iI As Long
For iI = Zeile1 To Zeile2
If ws.Rows(iI).PageBreak = xlPageBreakAutomatic Then
CheckSeitenwechsel = True
Exit For
End If
Next
End Function
Sub SeitenwechselLoeschen(ws As Worksheet, Zeile1 As Long, Zeile2 As Long)
'manuelle horizontale Seitenwechsel im Bereich löschen
Dim iI As Long
For iI = Zeile1 To Zeile2
If ws.Rows(iI).PageBreak = xlPageBreakManual Then
ws.Rows(iI).PageBreak = 0
End If
Next
End Sub