将许多Excel工作表另存为PDF

Question

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个元素。

Answer 1

正如斯科特·霍尔茨曼（Scott Holtzman）在评论中指出的那样，您将myArr的尺寸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