你的问题核心出在PageSetup的缩放设置上——原代码里的.FitToPagesWide = 1和.FitToPagesTall = 1会强制把所有内容压缩到1页内，不管UsedRange有多大。要实现多页PDF，我们需要调整这两个属性，同时优化代码里的冗余逻辑。

修改后的完整代码 #

Dim attendSh As Worksheet
Dim numSheets As Integer
numSheets = UBound(SlotArray) - LBound(SlotArray) + 1 ' 修正数量计算（原代码用UBound可能不对，取决于数组起始）

' 遍历每个工作表，设置打印区域和页面布局
For z = LBound(SlotArray) To UBound(SlotArray)
    Set attendSh = ThisWorkbook.Sheets(SlotArray(z))
    With attendSh.PageSetup
        .Orientation = xlLandscape
        .CenterHorizontally = True
        .PrintComments = False
        .PrintGridlines = False
        ' 关键修改：取消强制单页适配，改为按宽度适配1页，高度自动分页
        .FitToPagesWide = 1
        .FitToPagesTall = False ' 设为False后，内容会按高度自动分页
        ' 如果不需要宽度适配，也可以都设为False，用Zoom控制：
        ' .FitToPagesWide = False
        ' .FitToPagesTall = False
        ' .Zoom = 90 ' 按比例缩放，超出部分自动分页
    End With
    ' 设置打印区域为UsedRange
    attendSh.PageSetup.PrintArea = attendSh.UsedRange.Address
Next z

' 简化工作表选择：直接用数组选中所有目标工作表，不用逐个Case判断
ThisWorkbook.Sheets(SlotArray).Select

' 导出PDF
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    FilePath & "\" & Year & " Monthly Attendance\" & Year & " " & Month & " Attendance.pdf", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

关键修改说明 #

1. 移除强制单页适配：

   • 将.FitToPagesTall = 1改为.FitToPagesTall = False，这样当内容高度超出一页时，会自动分页；
   • 如果不需要固定宽度为1页，也可以把.FitToPagesWide也设为False，配合.Zoom设置缩放比例（比如90%），内容超出页面的部分会自动分页。

2. 设置打印区域为UsedRange：

   • 原代码只是选中UsedRange，但没有设置为打印区域，添加attendSh.PageSetup.PrintArea = attendSh.UsedRange.Address确保导出时包含所有已使用区域。

3. 简化工作表选择逻辑：

   • 原代码的Select Case完全可以用ThisWorkbook.Sheets(SlotArray).Select替代，因为SlotArray本身就是存储工作表名称的数组，Excel支持直接用数组选中多个工作表。

4. 修正工作表数量计算：

   • 原代码numSheets = UBound(SlotArray)如果数组是从0开始的，得到的是最后一个索引，不是实际数量，改成numSheets = UBound(SlotArray) - LBound(SlotArray) + 1更严谨（不过修改后的代码已经不需要这个变量了）。

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