• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Need Help: Trying to Save multiple sheets as a single pdf using VBA and Listbox

bmjones1013

New Member
I'm new to creating codes and macros. What I'm looking to do is create a template that allows our managers to fill in a few pieces of information on my DATA tab that will feed into the other tabs. Then they will click on the sheet names they want to save as one pdf by clicking these sheet names in a list box. Then to save as one PDF, I'm trying to create a code so when the click on the form control button, the code/macro runs and pops up a save as dialog box with PDF already selected as the file type, and they can save it anywhere of their choosing. After lots of searching, I was able to create the code below. For the most part it works, except no matter which sheets I choose from my list box it prints all sheets in the workbook. Please help me find and fix my mistake.

>>> use code - tags <<<
Code:
Sub Save_Workbook_As_PDF()
Dim i As Long, c As Long
Dim SheetArray() As String

With ActiveSheet.ListBoxSh

For i = 0 To .ListCount - 1
If .Selected(i) Then
ReDim Preserve SheetArray(c)
SheetArray(c) = .List(i)
c = c + 1
End If
Next i

End With

With Application.FileDialog(msoFileDialogSaveAs)

PDFindex = 0
For i = 1 To .Filters.Count
If InStr(VBA.UCase(.Filters(i).Description), "PDF") > 0 Then PDFindex = i
Next

.Title = "Save workbook as PDF"
.InitialFileName = PDFfileName
.FilterIndex = PDFindex

If .Show Then
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=.SelectedItems(1), _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End If

End With

End Sub
 
Last edited by a moderator:
bmjones1013
You seems to save those selected sheets in the 1st with ... end with
but
Where do You ... try to use those selected sheets later?
Do the 2nd with ... end with's .show really has some connection to that?

... without even a sample file, it's challenge to test nor verify.
 
Here's a mock up. When I choose all the tab names from the listbox minus the data tab, the portion of the code up to print preview works, but somewhere in my code below that where it brings up the save as dialog box it saves the entire workbook including the data tab, which is not needed or selected.
 

Attachments

  • TEST FILE.xlsm
    141.3 KB · Views: 13
bmjones1013
I tried to ask two questions ... ( questions -> answers )
and
You mock has these codes ...
Screenshot 2020-08-13 at 22.37.51.png
... and my Excel-version can open Your Mock as read-only ... for some reason.
 
A few changes...
Code:
Sub Save_Workbook_As_PDF()
    Dim i As Long, c As Long
    Dim SheetArray() As String

    With ActiveSheet.ListBoxSh
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ReDim Preserve SheetArray(c)
                SheetArray(c) = .List(i)
                c = c + 1
                .Selected(i) = False
            End If
        Next i
    End With
    
    With Application.FileDialog(msoFileDialogSaveAs)
        Dim PDFindex As Long, PDFfilename
        
        PDFindex = 0
        For i = 1 To .Filters.Count
            If InStr(VBA.UCase(.Filters(i).Description), "PDF") > 0 Then PDFindex = i
        Next
        
        .Title = "Save workbook as PDF"
        .InitialFileName = PDFfilename
        .FilterIndex = PDFindex
        If .Show Then
            ActiveWorkbook.Sheets(SheetArray).Copy
            ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=.SelectedItems(1), _
                                               Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        End If
        
    End With
    
End Sub
...and...
Code:
Private Sub Worksheet_Activate()
    Dim Sh As Worksheet
    With Me.ListBoxSh
       .ListStyle = fmListStyleOption
        .MultiSelect = fmMultiSelectMulti
        .Clear
        For Each Sh In ThisWorkbook.Sheets
            If Sh.Name <> "DATA" Then .AddItem Sh.Name
        Next Sh
    End With
End Sub
 
Back
Top