Page Break Macro

[KC Rippstein]

I have a sheet set up with a pivot table that is ready to print, except the
auto-positioning of page breaks sometimes breaks up related items. Main row
fields are in column A, and sub-related items are directly underneath that
and indented in column B (like an outline view). I'd like to see if the
page break is happening in the middle of the sub-items (so B has a value)
and just move the break up above the main row item (where B is empty).

Here is my humble attempt so far, which does the job correctly once but then
does not advance down the worksheet. I think once I set a manual page
break,
it messes up my For...Next loop because all the other auto-page breaks
following are reassigned??

'==================
Sub FormatPageBreaks()
Dim oHPgbr As HPageBreak
Dim iRow As Long

ActiveSheet.ResetAllPageBreaks

On Error Resume Next
For Each oHPgbr In ActiveSheet.HPageBreaks
iRow = oHPgbr.Location.Row
If Cells(iRow, "B").Value = "" Then
Else
Do Until Cells(iRow, "B").Value = ""
iRow = iRow - 1
Loop
Rows(iRow).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End If
Next
End Sub

 

[Earl Kiosterud]

KC,

I wrote such a macro for someone in these newsgroups a couple months ago. It seemed to
work. Never did get a reply, so I don't know if it worked, cost her her job, or just what.
Try using Google Groups and search for something like page breaks Earl Kiosterud.

 

[KC Rippstein]

Earl, you are a lifesaver!! I was able to modify your code perfectly to fit
my situation, which differed greatly but was fairly easy to figure out based
on your fine code!

Private Sub Workbook_BeforePrint(Cancel As Boolean)

Const ColumnKey = 2 ' Key column for groups
Dim HCtr As Double
Dim i As Integer, j As Integer
Dim lRow As Long

ActiveSheet.ResetAllPageBreaks
HCtr = 0 ' Total row height accumulator for page
i = 1 ' row counter
lRow = Cells(Rows.Count, 1).End(xlUp).Row ' last row
Do While i < lRow
HCtr = HCtr + Rows(i).Height ' accumulate height
i = i + 1 ' next row
If HCtr > 450 Then ' landscape vertical height max
For j = i To 0 Step -1 ' go back through rows
If Cells(i, ColumnKey).Value = "" Then Exit For
' at beginning of group, found a break, get out
i = i - 1 ' otherwise move up to previous row
Next j ' and reevaluate
ActiveWindow.SelectedSheets.HPageBreaks.Add _
Before:=Cells(i, ColumnKey).EntireRow
HCtr = 0
End If ' HCtr
Loop
End Sub

Brilliant.

KC,

I wrote such a macro for someone in these newsgroups a couple months ago.
It seemed to work. Never did get a reply, so I don't know if it worked,
cost her her job, or just what. Try using Google Groups and search for
something like page breaks Earl Kiosterud.

 

[Earl Kiosterud]

KC,

Glad to hear it.

There's a 450 that really shouldn't be in a statement. It's better programming to do
something like:

Const PageHeight = 450 ' Page height
..
..
..
If HCtr > PageHeight Then ' landscape vertical height max
..
..
--
Earl Kiosterud
www.smokeylake.com
-----------------------------------------------------------------------

Earl, you are a lifesaver!! I was able to modify your code perfectly to fit my situation,
which differed greatly but was fairly easy to figure out based on your fine code!

Private Sub Workbook_BeforePrint(Cancel As Boolean)

Const ColumnKey = 2 ' Key column for groups
Dim HCtr As Double
Dim i As Integer, j As Integer
Dim lRow As Long

ActiveSheet.ResetAllPageBreaks
HCtr = 0 ' Total row height accumulator for page
i = 1 ' row counter
lRow = Cells(Rows.Count, 1).End(xlUp).Row ' last row
Do While i < lRow
HCtr = HCtr + Rows(i).Height ' accumulate height
i = i + 1 ' next row
If HCtr > 450 Then ' landscape vertical height max
For j = i To 0 Step -1 ' go back through rows
If Cells(i, ColumnKey).Value = "" Then Exit For
' at beginning of group, found a break, get out
i = i - 1 ' otherwise move up to previous row
Next j ' and reevaluate
ActiveWindow.SelectedSheets.HPageBreaks.Add _
Before:=Cells(i, ColumnKey).EntireRow
HCtr = 0
End If ' HCtr
Loop
End Sub

Brilliant.