PDA

View Full Version : Solved: page breaks question



JimmyTheHand
06-26-2007, 10:57 PM
Hello,

In thread http://www.vbaexpress.com/forum/showthread.php?t=13260 (http://www.vbaexpress.com/forum/showthread.php?t=13260), forum member geekgirlau has provided a very handy little code about pagebreaks. See below.

Sub BottomLine()
Dim ws As Worksheet
Dim pb As HPageBreak
Dim LastRow As Long


For Each ws In ThisWorkbook.Worksheets
ActiveWindow.View = xlPageBreakPreview

For Each pb In ws.HPageBreaks
LastRow = pb.Location.Offset(-1, 0).Row

With ws.Rows(LastRow).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Next pb
Next ws
End Sub I found that in case the last used row of a worksheet is also the location of the last pagebreak, then the code doesn't work, it gives me Subscript out of range error. See the attachment. I tried a different approach, too, butSet pb = ws.HPageBreaks(ws.HPageBreaks.Count) gives the same error.

What is the cause? How can you overcome it?

Thanks

Jimmy

geekgirlau
06-26-2007, 11:30 PM
Hmmm that's an interesting one ...

One way around it (and I'm sure there's others) would be to test for error 9, and insert a temporary new row at the bottom of the current used range for the sheet. Once a new row is inserted, the page breaks work correctly. You'd probably need a either a flag so that you know to go back and delete the temporary row, or maybe just enter a nonsense value (like "@#$") and do a replace to clear it at the end.

geekgirlau
06-26-2007, 11:38 PM
Sub BottomLine()
Dim ws As Worksheet
Dim pb As HPageBreak
Dim LastRow As Long


For Each ws In ThisWorkbook.Worksheets
ActiveWindow.View = xlPageBreakPreview

On Error GoTo ErrHandler
For Each pb In ws.HPageBreaks
LastRow = pb.Location.Offset(-1, 0).Row

With ws.Rows(LastRow).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Next pb

On Error Resume Next
ws.Cells.Replace What:="@#$", Replacement:="", LookAt:=xlWhole
Next ws


ExitHere:
Exit Sub

ErrHandler:
Select Case Err.Number
Case 9
' subscript error - need additional row added
ws.Range("A" & ws.UsedRange.Rows.Count + 1).Formula = "'@#$"
Resume
Case Else
MsgBox Err.Description, vbCritical, "Unexpected error: " & Err.Number
Resume ExitHere
End Select
End Sub

JimmyTheHand
07-01-2007, 11:43 PM
Thanks for the tip, Geekgirlau. I liked this trick. :thumb
Sorry for being this late in responding, I was busy and, kind of, forgot about it. Remembered just now to give you the due credit.
Thanks again.

Jimmy

geekgirlau
07-02-2007, 06:12 PM
My pleasure - don't forget this does NOT deal with previous border lines - may need to clean up existing borders first, although depending on the format of your sheet ... hmmm

JimmyTheHand
07-03-2007, 12:04 AM
My pleasure - don't forget this does NOT deal with previous border lines - may need to clean up existing borders first, although depending on the format of your sheet ... hmmm
I won't forget, I promise :)
The task I had had in mind had nothing to do with borders, I only was interested in a reliable way to determine pagebreak locations.

Cheers,

Jimmy