CODEWITHSUNDEEP
vbaexcelsave
bdpolinsky
bdpolinsky

Reputation: 491

Save a number of excel worksheets as a PDF

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

This subroutine takes information from a userform, which has user inputted variables in FromBox and ToBox; these are both longs. The goal is to be able to save, for instance, sheets 2 - 10. The parameters are specified by the user.

the following code, with the bottom section uncommented, works when the user specifies all of the worksheets (IE there are 10 worksheets, and the user specifies range 1-10). But when the user specifies 2-10, it fails.

The problem, I think, is that I'm trying to select 10 elements with a 9 element long array.

Upvotes: 0

Views: 80

Answers (1)

YowE3K
YowE3K

Reputation: 23974

As Scott Holtzman pointed out in a comment, you are dimensioning myArr larger than it should be. It therefore has unassigned values in it, which are left as the default zero value, and that causes problems because you don't have a sheet 0 to be selected.

I think the following code should work:

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

Upvotes: 2

Related Questions