将多个 Excel 工作表另存为 PDF

Posted 2023-05-07

【中文标题】将多个 Excel 工作表另存为 PDF

【英文标题】：Save a number of excel worksheets as a PDF

【发布时间】：2017-03-03 19:47:21

【问题描述】：

Option Explicit

Dim mySheets As Dictionary 

Private Sub SaveAndOpen_Click()

   'set up variables
   Dim i As Long
   Dim j As Long
   Dim myArr() As Long
   Dim filename As String
   ReDim myArr(1 To Sheets.Count)

   j = 1

   'make bounds
   Dim from As Long
   Dim tonum As Long

   'numbers inputted from a userform
   from = FromBox.Value
   tonum = ToBox.Value
   filename = Cells(3, 4) & "." & mySheets.Item(from) & "-" & mySheets.Item(tonum)
   For i = 1 To mySheets.Count

        If i >= FromBox.Value And i <= ToBox.Value Then
            myArr(j) = i
            j = j + 1
        End If
   Next i

   Dim filepath As String
   For i = 1 To UBound(myArr)
        filepath = filepath & myArr(i)
   Next i


   filepath = "c:\file\path\here\"

   ThisWorkbook.Sheets(myArr).Select

   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
    filepath & filename, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
     IgnorePrintAreas:=False, OpenAfterPublish:=True

   ThisWorkbook.Sheets(1).Select
End Sub


Private Sub UserForm_Initialize()
    Copies.Value = 1
    FromBox.Value = 1


    Dim i As Long

    Set mySheets = New Dictionary
    For i = 1 To ActiveWorkbook.Sheets.Count
        mySheets.Add i, ActiveWorkbook.Sheets(i).Name
        SheetBox.Value = SheetBox.Value & i & " - " & ActiveWorkbook.Sheets(i).Name & vbCrLf
    Next i

    ToBox.Value = i - 1

End Sub

这个子程序从用户表单中获取信息，用户表单在 FromBox 和 ToBox 中有用户输入的变量；这些都是多头。目标是能够保存，例如，工作表 2 - 10。参数由用户指定。

当用户指定所有工作表（IE 有 10 个工作表，用户指定范围 1-10）时，下面的代码（底部未注释）有效。但是当用户指定2-10时，就失败了。

我认为，问题在于我试图用 9 个元素的长数组选择 10 个元素。

【问题讨论】：

ReDim myArr(1 To ToBox.Value - FromBox.Value - 1) 我想会解决它。那是伪代码，可能不完全有效，但我想你明白我的意思。

什么是mySheets 我没有看到变量集？- 在代码顶部添加Option Explicit 并运行它。

【参考方案1】：

正如 Scott Holtzman 在评论中指出的那样，您将 myArr 的尺寸设置为大于应有的尺寸。因此，其中包含未分配的值，这些值保留为默认零值，这会导致问题，因为您没有要选择的工作表 0。

我认为下面的代码应该可以工作：

Option Explicit

Dim mySheets As Dictionary 

Private Sub SaveAndOpen_Click()

   'set up variables
   Dim i As Long
   Dim j As Long
   Dim myArr() As Long
   Dim filename As String

   'make bounds
   Dim from As Long
   Dim tonum As Long

   'numbers inputted from a userform
   from = FromBox.Value
   tonum = ToBox.Value

   'Check ToBox.Value is valid
   If tonum > Sheets.Count Then
       MsgBox "Invalid To value"
       Exit Sub
   End If
   'Check FromBox.Value is valid
   If from > tonum Then
       MsgBox "Invalid From value"
       Exit Sub
   End If

   'Setup myArr
   ReDim myArr(from To tonum)
   For j = from To tonum
       myArr(j) = j
   Next

   filename = Cells(3, 4) & "." & mySheets.Item(from) & "-" & mySheets.Item(tonum)
   '
   Dim filepath As String
   'For i = LBound(myArr) To UBound(myArr)
   '     filepath = filepath & myArr(i)
   'Next i


   filepath = "c:\file\path\here\"

   ThisWorkbook.Sheets(myArr).Select

   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
    filepath & filename, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
     IgnorePrintAreas:=False, OpenAfterPublish:=True

   ThisWorkbook.Sheets(1).Select
End Sub

【讨论】：

谢谢！此代码有效。我的困惑之一 - 如果我将数组重新调整为（2 到 9），VBA 是否会创建该数组的索引（2,3,4,5,6,7,8,9）或（0,1,2， 3,4,5,6,7)?我了解到数组的索引总是从 0 开始，所以我想即使我重新调整数组，索引仍然会从 0 开始。

@bdpolinsky - 如果数组被声明为 Dim myArr(2 To 9) 则 LBound（下限）为 2 - 即 myArr(1) 会给出下标超出范围错误。 （在幕后，数组将有效地存储为从零开始，但编译器将生成代码以始终减少下限使用的任何索引以确定要使用的位置。因此，在MyArr(2 To 9) 的情况下，使用MyArr(5) 会导致使用5-2 位置。在MyArr(-10 To 7), using MyArr(-5)` 的情况下，会导致使用-5 - -10 位置，即5。但这都是在幕后！ )