将多个 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 的尺寸设置为大于应有的尺寸。因此，其中包含未分配的值，这些值保留为默认零值，这会导致问题，因为您没有要选择的工作表 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