An Inelegant Excel PageBreak Solution
I have an Excel report:
row 1 headings (23 columns)
Variable row depth
rows logically grouped on Column A value.
Print requirement:
ONE page wide
page break ONLY when Column A value changes but not on EVERY column A value change.
Column A PageBreak Example:
BEFORE:
a
a
a
b
b
b
b
c
c_ _ _ _ _ _ _ _ _ Auto Page Break
d
d
d
d
d
AFTER:
a
a
a
b
b
b
b_________________ MANUAL Page Break
c
c
d
d
d
d
d
What I have discovered is that when the PageSetup.Zoom property is assigned FALSE, along with the FitToPagesWid=1 and FitToPagesTall=999, then the HPageBreaks.Add method does NOTHING.
So after fiddling with this for over a week, and getting some helpful advise from
xlbo, I stumbled upon this inelegant solution. Can anyone find a better way?
CODE
Sub PageSetupZoom()
Dim nZoom As Integer
'assign the MAXIMUM zoom value
nZoom = 400
With ActiveSheet
.ResetAllPageBreaks
Do
.PageSetup.Zoom = nZoom
'toggling between NORMAL & PAGE BREAK PREVIEW is the only way I could get the darn setup to actually change!!!
ActiveWindow.View = xlNormalView
ActiveWindow.View = xlPageBreakPreview
'decriment the zoom value
nZoom = nZoom - 5
'when there are NO VPageBreak objects, that's when I have a page that is 1 wide AND ZOOM is not FALSE!!!
Loop While .VPageBreaks.Count > 0
End With
ReformatPageBreaks ActiveSheet, ActiveSheet.[A1]
End Sub
Having setup my page for printing, now I can reformat the HPageBreaks, which appears ONLY TO WORK when the PageSetup.Zoom property is not FALSE...
CODE
Sub ReformatPageBreaks(ws As Worksheet, rg As Range)
Dim lRow As Long, i As Integer, iCol As Integer
iCol = rg.Column
With ws
' .ResetAllPageBreaks
Do
'next page break
lRow = .HPageBreaks(i).Location.Row
Do While .Cells(lRow, iCol).Value = .Cells(lRow - 1, iCol).Value
lRow = lRow - 1
Loop
.HPageBreaks.Add .Cells(lRow, iCol)
i = i + 1
Loop Until .HPageBreaks.Count < i
End With
End Sub
What say ye?
Skip,
Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty!
An Inelegant Excel PageBreak Solution
...
.