Excel VBA中检测分页符以放置自定义页脚的最优方法

问题背景 #

我正在编写Excel宏，用于将可变长度数据（A:I列，1~数百行）编译到工作表中，要求在数据最后一行后添加占据5行的工作表内页脚（不能使用Excel自带页脚区域），且保存为Excel/PDF/Word格式时页脚不得跨页。

此前的实现依赖固定行高（所有行高设为40），按每页10行计算分页（第1页13_{22行，第2页23}32行，以此类推），但现在部分单元格因自动换行导致行高超过40，原有固定行数的分页计算逻辑失效，需要可靠的动态分页符检测方法。

注：COA工作表1~12行是标题区，数据从13行开始；若页脚无法放在当前页，需将最后一行数据移至新页面后再放置页脚。

原有失效代码 #

以下代码通过固定行数计算分页，无法适配动态行高场景：

Public Sub COA_DetectedEOD()
'Purpose: Sub checks when the COA document ends and determines where
'the footer will go.
'If footer does not fit on the current last page of the document,
'then the last data point is cut/pasted at the start of the next new page
'and the footer is placed at the bottom of that new page.
Dim ws As Worksheet
Dim Lrow As Integer, i As Integer, cnt As Integer
Dim PgBtm As Integer, FtReq As Integer

Set ws = ThisWorkbook.Worksheets("COA")
Lrow = FindLastRow(ws, 1).Row   'Find the last row on COA sheet

FtReq = 4   'Number of rows required for footer to fit on page.
PgBtm = 22  'Row number of last row on COA page
i = 1       'COA page count
cnt = Lrow  'counter to calculate # of pages on COA.

'Determine how many pages are on the COA sheet
Do While cnt > 22
    cnt = cnt - 10  'each COA page is 10 rows
    i = i + 1       'count # of pages
Loop

'Update PgBtm variable with the last row number on page
PgBtm = (i * 10) + 12

'------------------------ ADD FOOTER ------------------------
If PgBtm - Lrow > FtReq Then
    Call COA_InsertFooter(Lrow + 2) 'The "+2" ensures the footer has a little separation from the data. 
Else
    'The page is too full for the footer to fit. Move last data row to the next new page
    ws.Rows(Lrow).EntireRow.Cut ws.Range("A" & PgBtm + 1)
    'Re-format row height on cut row (row Height goes back to default)
    ws.Range("A" & Lrow).RowHeight = 40
    'Add Footer to the bottom of the page
    Call COA_InsertFooter(PgBtm + 10 - FtReq)
End If

Terminate:
Set ws = Nothing
End Sub

新解决方案：基于分页符的动态检测 #

通过在数据后填充固定行高的辅助行，触发Excel自动计算分页符，精准获取当前最后一页的边界，判断页脚是否可容纳，若不可则调整数据位置：

Public Sub COA_DetectPageBreak()
'Purpose: Sub detects where the last page break is on the COA worksheet.
'Depending where the page break is, the footer will be inserted on
'the last page of the COA or placed on a new (last) page.
'If the Footer must be put onto a new page, then the last row of data will
'need to be cut/pasted to the new last page. Footer should be put as far
'down on the page as possible without getting cut off.

Dim ws As Worksheet
Dim Lrow As Long        'Last row of COA data on worksheet
Dim pb As HPageBreak    'Page Break location = top left cell address.
Dim BtmPgRow As Long    'Last row before the page break
Dim LDataRowH As Long   'Row height of the last data row

Set ws = ThisWorkbook.Worksheets("COA")
Lrow = FindLastRow(ws, 1).Row    'User Defined Function

'Add 45 x's to each row after COA data, change the row's height to 10
ws.Range(ws.Cells(Lrow + 1, "A"), ws.Cells(Lrow + 46, "A")).Value = "x"
ws.Range(ws.Cells(Lrow + 1, "A"), ws.Cells(Lrow + 46, "A")).RowHeight = 10

With ws
    For Each pb In ws.HPageBreaks
        'Find the last page break on worksheet
        If pb.Location.Row >= Lrow Then
            'Assign the last pagebreak row to variable
            '"-1", b/c pb.location.row is the row number under the pagebreak
            BtmPgRow = pb.Location.Row - 1

            'Check if Footer fits between the last data row and before the pagebreak
            '14 rows at row.height = 10 is required for Footer to fit
            If BtmPgRow - Lrow >= 14 Then

                'Remove the x's
                ws.Range(ws.Cells(Lrow + 1, "A"), ws.Cells(Lrow + 46, "A")).Value = ""
                'Add Footer to the bottom of the page
                'The -14 spaces the Footer as far down on the page as possible
                'User defined Sub that pastes and formats my Footer onto the COA worksheet.
                Call COA_InsertTableFooter(BtmPgRow - 14)
            Else
                'The Footer will not fit on the page. Move it to the next page
                'The last line of COA data must be moved to the new page too
                'Save the last data row's height value
                LDataRowH = ws.Range("A" & Lrow).RowHeight
                
                'Cut data row, paste on first row on new page.
                .Rows(Lrow).EntireRow.Cut ws.Range("A" & BtmPgRow + 1)
                
                'Re-format row height on cut row (row height goes back to default)
                ws.Range("A" & Lrow).RowHeight = LDataRowH
                
                'Change Lrow to BtmPgRow + 1
                Lrow = BtmPgRow + 1
                'Find the new page bottom by looping to next pb
            End If
        End If
    Next pb
End With

Set ws = Nothing
End Sub

方案说明 #

1. 辅助行填充：在数据后添加45行A列填充"x"并设置行高10，模拟一页空白行的高度，确保Excel能计算出完整的分页边界
2. 分页符检测：遍历HPageBreaks获取数据区域后的最后一个分页符，通过pb.Location.Row - 1得到当前页的最后一行
3. 页脚适配判断：计算当前页剩余空间是否能容纳页脚（对应14行高10的行），能则直接插入；不能则将最后一行数据移至新页面，再插入页脚
4. 清理还原：插入页脚后清除辅助行的填充内容，保证工作表整洁

内容的提问来源于stack exchange，提问作者Qstein