Underline a worksheet

[Fergus]

I have a very simple VBA sub which is intended to underline a worksheet at each page break when printed. The total length of the worksheet is 3574 rows. The sub works fine down to row number 1477 but then gives an error message "subscript out of range". I have used this in the past on Excel 2007 and it worked fine over worksheets of up to 600 rows.

Can anyone tell me what I am doing wrong? Here's the sub which I put into Thisworkbook. It is called from a button.

Sub underline()
For Each pgbr In ActiveSheet.HPageBreaks

With pgbr.Location
With Range(.Offset(-1, 0), .Offset(-1, 17)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
Next
End Sub

 

[Yongle]

I do not think you are doing anything wrong - I hit the same problem at the 20th page break

This seems to work for me with Excel 2016

Sub underline2()
    Dim pgBr As HPageBreak, c As Long
    For c = 1 To ActiveSheet.HPageBreaks.Count
        On Error Resume Next
        With ActiveSheet.HPageBreaks(c).Location
            With Range(.Offset(-1, 0), .Offset(-1, 17)).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
        End With
    Next
End Sub

 

[Fergus]

Thanks Yongle

Putting your code in gets down to page no 45 then ends without any error message. I haven't managed to get it down beyond that. When I try to debug and keep my finger on F8 c gets up to 72 but still the underline stops at 45.

Any ideas?