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

此子程序从userform获取信息，userform在FromBox和ToBox中有用户输入的变量;这些都是长期的。目标是能够保存例如表2-10。参数由用户指定。

以下代码（底部未注释）在用户指定所有工作表时工作（IE有10个工作表，用户指定范围1-10）。但是当用户指定2-10时，它会失败。

我认为，问题在于我正在尝试选择10个元素，其中包含9个元素的长数组。

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

将许多Excel工作表保存为PDF

1 个答案: