AW: Zeilenblock ohne Seitenumbruch
05.09.2008 17:13:00
fcs
Hallo Bully,
dann muss die Prüfung der Blattnamen etwas anders aufgebaut werden. Die Namen der Blätter in der 1. Case-Zeile muss du entsprechend anpassen.
So wird für die neuen Kundenblätter vor dem Drucken der Seitenwechsel gesetzt.
Gruß
Franz
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wks As Worksheet, Zeile As Long, ZeileLast As Long
Const AnzZeilen As Long = 11 'Anzahlzeilen, die ggf. auf letzte Seite sollen.
Select Case ActiveSheet.Name
Case "Blatt1", "Blatt2", "Blatt3"
'Namen der Blätter in denen der Seitenwechsel nicht gesetzt werden soll
'do nothing
Case Else
'ggf. vor Zusammenfassung einen Seitenwechel setzen
Set wks = ActiveSheet
With wks
'Letzet Zeile mit Daten in Spalte A ermitteln
ZeileLast = .Cells(.Rows.Count, 1).End(xlUp).Row
'ggf vorhandenen horizontalen Seitenwechsel vor Zusammenfassung löschen
.Rows(ZeileLast - AnzZeilen + 1).PageBreak = xlPageBreakNone
'Prüfen, ob vor einer der letzten 10 Zeilen ein automatischer Seitenwechsel ist
For Zeile = ZeileLast - AnzZeilen + 2 To ZeileLast
If .Rows(Zeile).PageBreak = xlPageBreakAutomatic Then
'Seitenwechsel vor Zusammenfassung setzen
.Rows(ZeileLast - AnzZeilen + 1).PageBreak = xlPageBreakManual
Exit For
End If
Next
End With
End Select
End Sub
Alternative kannst auch folgendes machen:
Nach dem Ausfüllen der Vorlage bzw. vor dem Kopieren des ausgefüllten Blatts führst du das folgende Makro aus.
Auch unmitelbar nach dem Kopieren ginge, dann als Parameter verwenden: wks:=Activesheet
'Zeile zum Aufrufen der Prozedur, Name des Tabellenblatts ggf. vorher anpassen
Call Seitenwechsel(wks:=Worksheets("Vorlage"))
'Prozedur:
Sub Seitenwechsel(wks As Worksheet)
Dim Zeile As Long, ZeileLast As Long
Const AnzZeilen As Long = 11 'Anzahlzeilen, die ggf. auf letzte Seite sollen.
With wks
'Letzet Zeile mit Daten in Spalte A ermitteln
ZeileLast = .Cells(.Rows.Count, 1).End(xlUp).Row
'ggf vorhandenen horizontalen Seitenwechsel vor Zusammenfassung löschen
.Rows(ZeileLast - AnzZeilen + 1).PageBreak = xlPageBreakNone
'Prüfen, ob vor einer der letzten 10 Zeilen ein automatischer Seitenwechsel ist
For Zeile = ZeileLast - AnzZeilen + 2 To ZeileLast
If .Rows(Zeile).PageBreak = xlPageBreakAutomatic Then
'Seitenwechsel vor Zusammenfassung setzen
.Rows(ZeileLast - AnzZeilen + 1).PageBreak = xlPageBreakManual
Exit For
End If
Next
End With
End Sub