Excel VBA打印指定列到PDF出现分页问题：选中列分两页输出

问题根源 #

你选择的A-D列和H列属于不连续区域，Excel打印时会保留这些列之间的空白列（E、F、G），即便这些列没有数据，它们的宽度仍会被计入打印总宽度，导致超出单页范围，最终被拆分到两页输出。

解决方案1：隐藏无关列后打印（推荐，不改动原数据） #

在设置打印区域前，先隐藏不需要的E-G列，打印完成后再恢复列的可见状态，这样打印时只会计算目标列的宽度，不会被空白列占用空间。

修改后的完整代码：

Private Sub create_Click()
    Dim r As Range
    Dim cell As Range
    Dim num As Integer
    Dim start As String
    Dim top As Integer
    Const check As String = "ITEM"
    ' 保存原列的可见状态，用于后续恢复
    Dim hiddenCols As Variant
    hiddenCols = Range("E:G").EntireColumn.Hidden

    Set r = Range("A:A")
    For Each cell In r
        If cell.Value <> check Then
            top = top + 1
        Else
            Exit For
        End If
    Next
        
    num = Cells(Rows.Count, 1).End(xlUp).Row
    start = "A" & top
    Worksheets("Liquidaciones").Range(start).AutoFilter Field:=13, Criteria1:=corcom
    start = "A" & top & ":A" & num
    Set r = Range(start)
    
    ' 隐藏不需要打印的列
    Range("E:G").EntireColumn.Hidden = True
    
    With ActiveSheet.PageSetup
        .PrintArea = Intersect(Range("A:D,H:H"), ActiveSheet.UsedRange).Address ' 简化列范围写法
        .Orientation = xlLandscape
        .PrintGridlines = True
        .Zoom = False
        .FitToPagesTall = False
        .FitToPagesWide = 1
    End With
    
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:="Z:\Personal\Report", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=False, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
    
    ' 恢复之前的列可见状态
    Range("E:G").EntireColumn.Hidden = hiddenCols
    
    Unload Me
End Sub

解决方案2：复制目标列到临时工作表打印 #

如果不想修改原工作表的列显示状态，可以把需要的列复制到新建的临时工作表，打印完成后删除该临时表：

Private Sub create_Click()
    Dim r As Range
    Dim cell As Range
    Dim num As Integer
    Dim start As String
    Dim top As Integer
    Const check As String = "ITEM"
    Dim tempSheet As Worksheet

    Set r = Range("A:A")
    For Each cell In r
        If cell.Value <> check Then
            top = top + 1
        Else
            Exit For
        End If
    Next
        
    num = Cells(Rows.Count, 1).End(xlUp).Row
    start = "A" & top
    Worksheets("Liquidaciones").Range(start).AutoFilter Field:=13, Criteria1:=corcom
    start = "A" & top & ":A" & num
    Set r = Range(start)
    
    ' 创建临时工作表
    Set tempSheet = ThisWorkbook.Worksheets.Add
    ' 复制需要的列到临时表
    Intersect(Range("A:D,H:H"), ActiveSheet.UsedRange).Copy tempSheet.Range("A1")
    
    With tempSheet.PageSetup
        .Orientation = xlLandscape
        .PrintGridlines = True
        .Zoom = False
        .FitToPagesTall = False
        .FitToPagesWide = 1
    End With
    
    tempSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:="Z:\Personal\Report", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=False, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
    
    ' 删除临时工作表，关闭确认提示
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True
    
    Unload Me
End Sub

关键说明 #

• 方案1更高效，仅通过隐藏/显示列实现，无数据复制操作，适合大数据量场景。
• 两种方案都能让目标列紧凑排列，配合FitToPagesWide = 1可将所有列压缩至单页输出。

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