VBA - print multiple sheets to pdf

[TommyV2209]

Hi all,

I have an Excel-worksheet with 7 tabs, where 5 are visible and 2 are not.
Depending on the values on the first 5 pages, I want them to print to a pdf (so sometimes only 3 pages need to print, sometimes all 5 of them).
I've put a simple formula in the hidden tab page ("Data") where I see if the tab page needs to be printed or not (1 = print, 0 = not print)

How can I put this into a VBA code that I can print to a pdf file?

Thanks for the help!

 

[John_w]

Try this macro:

Public Sub Save_Sheets_As_PDF()

    Dim wb As Workbook
    Dim currentSheet As Worksheet
    Dim PDFsheets() As Variant, IsVisible() As Boolean, numPDFsheets As Long
    Dim r As Long
    Dim PDFfileName As String
    
    Set wb = ThisWorkbook
    
    With wb
    
        Set currentSheet = .ActiveSheet

        numPDFsheets = 0
        With .Worksheets("Data")
            For r = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
                If .Cells(r, "B").Value = 1 Then
                    numPDFsheets = numPDFsheets + 1
                    ReDim Preserve PDFsheets(1 To numPDFsheets)
                    ReDim Preserve IsVisible(1 To numPDFsheets)
                    PDFsheets(numPDFsheets) = .Cells(r, "A").Value
                    IsVisible(numPDFsheets) = wb.Worksheets(.Cells(r, "A").Value).Visible
                    wb.Worksheets(.Cells(r, "A").Value).Visible = True
                End If
            Next
        End With
            
        If numPDFsheets > 0 Then
            PDFfileName = Left(.FullName, InStrRev(.FullName, ".") - 1) & ".pdf"
            .Worksheets(PDFsheets).Select
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfileName, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            currentSheet.Select True
            For r = 1 To numPDFsheets
                wb.Worksheets(PDFsheets(r)).Visible = IsVisible(r)
            Next
            MsgBox "Created PDF file '" & PDFfileName & "' containing " & numPDFsheets & " sheets"
        Else
            MsgBox "No sheets for printing, therefore PDF file not created"
        End If
    
    End With
    
End Sub

 

[TommyV2209]

Thanks! This works like a charm
Is there a way to get the "save as...-screen" instead of giving an automatic name?

 

[John_w]

Is there a way to get the "save as...-screen" instead of giving an automatic name?

Public Sub Save_Sheets_As_PDF2()

    Dim wb As Workbook
    Dim currentSheet As Worksheet
    Dim PDFsheets() As Variant, IsVisible() As Boolean, numPDFsheets As Long
    Dim r As Long
    Dim PDFFilename As Variant
    
    Set wb = ThisWorkbook
    
    With wb
    
        Set currentSheet = .ActiveSheet

        numPDFsheets = 0
        With .Worksheets("Data")
            For r = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
                If .Cells(r, "B").Value = 1 Then
                    numPDFsheets = numPDFsheets + 1
                    ReDim Preserve PDFsheets(1 To numPDFsheets)
                    ReDim Preserve IsVisible(1 To numPDFsheets)
                    PDFsheets(numPDFsheets) = .Cells(r, "A").Value
                    IsVisible(numPDFsheets) = wb.Worksheets(.Cells(r, "A").Value).Visible
                    wb.Worksheets(.Cells(r, "A").Value).Visible = True
                End If
            Next
        End With
            
        If numPDFsheets > 0 Then
            PDFFilename = Application.GetSaveAsFilename(InitialFileName:=ActiveSheet.Range("B3").Value, FileFilter:="PDF, *.pdf", Title:="Save As PDF")
            If PDFFilename <> False Then
                .Worksheets(PDFsheets).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFilename, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                currentSheet.Select True
                For r = 1 To numPDFsheets
                    wb.Worksheets(PDFsheets(r)).Visible = IsVisible(r)
                Next
                MsgBox "Created PDF file '" & PDFFilename & "' containing " & numPDFsheets & " sheets"
            End If
        Else
            MsgBox "No sheets for printing, therefore PDF file not created"
        End If
    
    End With
    
End Sub

 

[TommyV2209]

works perfect!
Thanks for the help!

 

[Mr_Ragweed2]

Is there a way to do this to a userform instead of a worksheet? I would have a worksheet cell reference to name the file. I want to save the file in a Microsoft Teams folder via Sharepoint.
Currently i can print the userform. I would like to print and save.

If i need to start a new thread i will. This code just seemed pretty close but i am just novice enough to not be able to adapt it.

 

[John_w]

Yes, please start a new thread.

 

[Mr_Ragweed2]

Just did. Thank you! can i post the name of that thread here or is that a no-no? Or probably just not needed since this thread is old....

 

[John_w]

Post a link to it, if you want.

 

[Mr_Ragweed2]

Thank You.
save userform as pdf file to Microsoft Teams folder