求助：VBA实现多单元格区域导出为单页纵向PDF报告

直接导出不连续单元格区域时，Excel会将每个区域视为独立打印范围，导致各占一页。可以通过临时工作表合并区域的方式实现单页导出，具体代码如下：

Private Sub CommandButtonPrintReport1_Click()
    Dim tempSheet As Worksheet
    Dim destRange As Range
    Dim sourceRanges As Variant
    Dim i As Integer
    
    ' 定义需要导出的多个区域
    sourceRanges = Array("G1:T5", "A6:O34", "P6:AC34")
    
    ' 创建临时工作表
    Set tempSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    
    ' 初始化目标起始位置
    Set destRange = tempSheet.Range("A1")
    
    ' 循环复制每个区域到临时表
    For i = LBound(sourceRanges) To UBound(sourceRanges)
        Sheet11.Range(sourceRanges(i)).Copy
        ' 粘贴时保留格式、图表和内容
        destRange.PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        destRange.PasteSpecial Paste:=xlPasteColumnWidths
        
        ' 更新下一个区域的起始位置（当前区域的行数+1，避免重叠）
        Set destRange = tempSheet.Cells(destRange.Row + Sheet11.Range(sourceRanges(i)).Rows.Count + 1, 1)
    Next i
    
    ' 设置页面布局为纵向，适配内容宽度
    With tempSheet.PageSetup
        .Orientation = xlPortrait
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintArea = tempSheet.UsedRange.Address
    End With
    
    ' 导出PDF
    tempSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=Environ("Userprofile") & "\OneDrive\Documents\Excel Templates\Management Reports\SCL_Report1.pdf", _
        Quality:=xlQualityStandard
    
    ' 删除临时工作表（不提示确认）
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True
    
    ' 清除剪贴板内容
    Application.CutCopyMode = False
End Sub

代码说明 #

• 创建临时工作表存放合并后的内容，避免修改原工作表
• 逐个复制目标区域，保留格式、图表和列宽，确保内容还原度
• 调整页面设置为纵向，强制适配单页宽度，高度随内容自动调整
• 导出完成后自动删除临时表，不影响原工作簿结构

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