Finding a PaqeBreak using VBA for Excel


Posted by Desmond on January 31, 2002 2:23 PM

I want to run a macro that needs to first find the
Pagebreak and after finding it, enter some data exactly
above before the PageBreaks.. I need to know the code
in VBA to find PageBreaks..

If you could please help me on this one...

Thanks



Posted by Diomedes on January 31, 2002 3:48 PM

The following will insert three rows of footers :-

Sub InsertFooters()
Dim TargetWB As Workbook, AWB As String
Dim TotalPageBreaks As Long, pbIndex As Long, pbRow As Long, PreviousPageBreak As Long
Application.ScreenUpdating = False
AWB = ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:="C:\My Documents\" & AWB & " _ New.xls"
Set TargetWB = ActiveWorkbook
' insert footers
pbIndex = 0
PreviousPageBreak = 1
TotalPageBreaks = ActiveSheet.HPageBreaks.Count
While pbIndex < TotalPageBreaks
pbIndex = pbIndex + 1
pbRow = GetHPageBreakRow(pbIndex)
If pbRow > 0 Then
InsertFooter pbRow, PreviousPageBreak, True, ""
PreviousPageBreak = pbRow
TotalPageBreaks = ActiveSheet.HPageBreaks.Count
Else
pbRow = TotalPageBreaks
End If
Wend
' add the last footer
InsertFooter Range("A65536").End(xlUp).Row + 1, PreviousPageBreak, False, ""
Range("A1").Select
End Sub

Private Sub InsertFooter(RowIndex As Long, PreviousPageBreak As Long, InsertNewRows As Boolean, LabelText As String)
Const RowsToInsert As Long = 3
Dim i As Long, TargetRow As Long
TargetRow = RowIndex
If InsertNewRows Then
For i = 1 To RowsToInsert
Rows(RowIndex - RowsToInsert).Insert
Next i
TargetRow = RowIndex - RowsToInsert
End If
If PreviousPageBreak < 1 Then PreviousPageBreak = 1
' insert the required footer text :
Cells(TargetRow, 1).Formula = "Footer line 1 text here"
Cells(TargetRow + 1, 1).Formula = "Footer line 2 text here"
Cells(TargetRow + 2, 1).Formula = "Footer line 3 text here"
End Sub

Private Function GetHPageBreakRow(PageBreakIndex As Long) As Long
GetHPageBreakRow = 0
On Error Resume Next
ActiveWorkbook.Names("ASPB").Delete
On Error GoTo 0
ActiveWorkbook.Names.Add "ASPB", "=get.document(64)", False
Columns("A:A").Insert
Range("A1:A50").FormulaArray = "=transpose(aspb)"
On Error Resume Next
GetHPageBreakRow = Cells(PageBreakIndex, 1).Value
On Error GoTo 0
Columns("A").Delete
ActiveWorkbook.Names("ASPB").Delete
End Function