Footers
Posted by Mark on October 15, 2001 11:12 AM
I am trying to acheive the same thing as "Rows to repeat at top" on the Sheet tab of Page setup, except that I want "Rows to repeat at bottom", i.e. a footer. With my requirements, I cannot use the standard header/footer. Is there anyway to achieve this result so that it prints a range at the bottom of every page?
Thanks,
Mark.
Posted by Jonathan on October 15, 2001 12:21 PM
ActiveSheet.UsedRange.Rows.Count
will give you the row number of the last row that has data in it (the last non-blank row) in the sheet. Take it from there.
HTH
Posted by Gyula Lorant on October 16, 2001 6:15 AM
Check whether this does what you need. I adapted some code from Ole P. Erlandsen, which involved adding sub-totals at page breaks.
The macro creates a new workbook with the same data, etc. but with footers on each page (I hope!) :-
Sub InsertSubtotals()
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").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
