如何在现有VBA代码中添加“Fit All Columns on One Page”打印机设置

我从网上找到一段实用的VBA代码，用来打印数据透视表首个报表筛选字段下每个项对应的内容。现在想加个额外步骤，把打印机设置改成将所有列调整到一页。作为VBA新手，我谷歌搜了相关方法但都没用，请问该怎么实现？

原代码如下：

Sub PrintFirstFilterItems()
'downloaded from contextures.com
 'prints a copy of pivot table
 'for each item in
 'first Report Filter field
On Error Resume Next
Dim ws As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Set ws = ActiveSheet
Set pt = ws.PivotTables(1)
Set pf = pt.PageFields(1)

If pf Is Nothing Then Exit Sub

For Each pi In pf.PivotItems
  pt.PivotFields(pf.Name) _
        .CurrentPage = pi.Name
  ActiveSheet.PrintOut  'for printing
  'ActiveSheet.PrintPreview  'for testing
Next pi
End Sub

要实现将所有列调整到一页的打印设置，只需在打印操作前添加工作表页面设置的代码即可。修改后的完整代码如下：

Sub PrintFirstFilterItems()
'downloaded from contextures.com
 'prints a copy of pivot table
 'for each item in
 'first Report Filter field
On Error Resume Next
Dim ws As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Set ws = ActiveSheet
Set pt = ws.PivotTables(1)
Set pf = pt.PageFields(1)

If pf Is Nothing Then Exit Sub

' 设置打印选项：将所有列调整到一页
With ws.PageSetup
    .FitToPagesWide = 1 ' 强制列宽适配1页
    .FitToPagesTall = False ' 行数不限制，自动分页
    .Zoom = False ' 必须关闭缩放，才能启用适配设置
End With

For Each pi In pf.PivotItems
  pt.PivotFields(pf.Name) _
        .CurrentPage = pi.Name
  ws.PrintOut  ' 改用提前定义的ws对象，更规范
  'ws.PrintPreview  ' 测试时可以用这个预览
Next pi
End Sub

关键说明： #

• .FitToPagesWide = 1：指定所有列必须缩放到一页宽度内
• .FitToPagesTall = False：允许内容按实际行数自动分页，不限制页数
• .Zoom = False：必须关闭缩放功能，否则适配设置不会生效
• 把原代码中的ActiveSheet换成定义好的ws对象，能避免操作过程中切换工作表导致的错误

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