VBA开发需求：自动调整行高后增加行间距，再过滤数据生成PDF

问题说明 #

我有一个命令按钮，功能是过滤数据后生成PDF用于打印。目前已设置自动调整行高，但文本排版过于拥挤，希望实现自动调整行高后添加内边距或翻倍行高以优化排版。此前尝试的代码仅能逐行修改行高，效果不佳。本人是VBA新手，通过论坛自学。

尝试的代码：

Rows("1:100").AutoFit
Rows("1:100").RowHeight = Rows("1:100").RowHeight * 2

现有命令按钮代码：

Private Sub CommandButton1_Click()

Sheets("PRINT OUT").Visible = True

Range("A1").AutoFilter Field:=3, Criteria1:="YES"

With ActiveSheet.PageSetup
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.1)
    .PaperSize = xlPaperA4
    .Orientation = xlLandscape
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = False

End With
[a1:x99].ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

Sheets("PRINT OUT").Visible = False

End Sub

解决方案 #

方法1：自动调整后批量翻倍可见行行高 #

你之前的代码问题在于直接给整行范围赋值RowHeight时，会把所有行统一设为第一个行的高度值，而非每行各自翻倍。下面的代码会只处理筛选后的可见行，确保每行在自适应后单独调整：

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim visibleRng As Range
    Dim row As Range
    
    Set ws = Sheets("PRINT OUT")
    ws.Visible = True
    
    ' 应用筛选
    ws.Range("A1").AutoFilter Field:=3, Criteria1:="YES"
    
    ' 设置页面格式
    With ws.PageSetup
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.1)
        .PaperSize = xlPaperA4
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With
    
    ' 获取筛选后的可见区域，自动调整行高后逐行翻倍
    Set visibleRng = ws.Range("A1:x99").SpecialCells(xlCellTypeVisible)
    visibleRng.Rows.AutoFit
    For Each row In visibleRng.Rows
        row.RowHeight = row.RowHeight * 2
    Next row
    
    ' 导出PDF
    ws.Range("A1:x99").ExportAsFixedFormat Type:=xlTypePDF, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    ws.Visible = False
End Sub

方法2：设置单元格内边距优化排版 #

如果不想修改行高，而是通过增加单元格内边距来缓解拥挤，可以用下面的方式（结合垂直居中让排版更美观）：

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim visibleRng As Range
    
    Set ws = Sheets("PRINT OUT")
    ws.Visible = True
    
    ' 应用筛选
    ws.Range("A1").AutoFilter Field:=3, Criteria1:="YES"
    
    ' 设置页面格式
    With ws.PageSetup
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.1)
        .PaperSize = xlPaperA4
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With
    
    ' 设置可见单元格的内边距与对齐方式
    Set visibleRng = ws.Range("A1:x99").SpecialCells(xlCellTypeVisible)
    With visibleRng
        .VerticalAlignment = xlVAlignCenter
        .RowHeight = .RowHeight + 4 ' 上下各增加2磅内边距，行高总计加4
    End With
    
    ' 导出PDF
    ws.Range("A1:x99").ExportAsFixedFormat Type:=xlTypePDF, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    ws.Visible = False
End Sub

关键提示 #

• 使用SpecialCells(xlCellTypeVisible)只处理筛选后的可见行，避免修改隐藏行的格式，提升运行效率。
• 行高调整的倍数或内边距增加的数值可以根据你的实际排版需求自行修改（比如把*2改成*1.5，或者把+4改成+6）。

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