按照分页预览页码拆分工作表并在打印标题区域写入相应页码信息

适用于具备水平分页,无垂直分页的Excel工作表的情况。
尽量保持原工作表格式而采用建立副本的方法,代码存在优化的可能。
本文假设打印标题不低于两行。

Sub SplitWorkbookByPrintPages()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim i As Long
    Dim lastRow As Long
    Dim totalPageNumber As Long
    Dim startRow As Long
    Dim endRow As Long
    Dim printTitleLastRow As Long
    Dim printTitleRows As String

    'Application.DisplayAlerts = False
    ' 设置源工作表
    Set wsSource = ThisWorkbook.Sheets("Sheet1") ' 替换为您的工作表名称
    
    ' 获取总页数
    totalPageNumber = wsSource.PageSetup.Pages.Count
    
    ' 获取打印标题行
    printTitleRows = wsSource.PageSetup.printTitleRows
    
    ' 获取打印标题的最后一行
    If printTitleRows <> "" Then
        printTitleLastRow = Split(Split(printTitleRows, ":")(1), "$")(1)
    Else
        printTitleLastRow = 0
    End If
    
    ' 获取最后一行
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历每个水平分页符
    For i = 1 To totalPageNumber
        ' 确定当前页的起始和结束行
        If i = 1 Then
            startRow = 1
        Else
            startRow = wsSource.HPageBreaks(i - 1).Location.Row
        End If
        
        If i < totalPageNumber Then
            endRow = wsSource.HPageBreaks(i).Location.Row - 1
        Else
            endRow = lastRow
        End If
        
        ' 创建新工作表(复制整个源工作表)
        wsSource.Copy After:=Worksheets(Worksheets.Count)
        Set wsDest = ActiveSheet
        
        ' 设置新工作表的名称
        wsDest.Name = "Page " & i
        
        ' 删除不需要的行,但保留打印标题行
        If totalPageNumber = 1 Then Exit Sub
        If i = 1 Then wsDest.Rows(endRow + 1 & ":" & lastRow).Delete
        
      
        If i > 1 Then
            If printTitleLastRow > 0 Then
                wsDest.Rows((printTitleLastRow + 1) & ":" & (startRow - 1)).Delete
            Else
                wsDest.Rows("1:" & (startRow - 1)).Delete
            End If
        End If
        If i < totalPageNumber Then
            wsDest.Rows((endRow - startRow + printTitleLastRow + 2) & ":" & lastRow).Delete
        End If
        
        ' 在指定单元格设置动态内容:页码及总页数
        wsDest.Range("E2").Value = "Page " & i & " of " & totalPageNumber
        wsDest.Range("E2").Font.Bold = True
        
        ' 保持原始的打印标题设置
        wsDest.PageSetup.printTitleRows = printTitleRows
        
        ' 调整打印区域
        wsDest.PageSetup.PrintArea = wsDest.UsedRange.Address
    Next i
    
    
    
    ' 删除源工作表(如果需要的话)
    'wsSource.Delete
    'Application.DisplayAlerts = True
End Sub
posted @ 2024-09-27 15:40  geyee  阅读(36)  评论(0)    收藏  举报