If worksheet name appears within range of cells then select

0
votes

I want to be able to save multiple specific worksheets to a PDF.

I currently have this code which works:

Sheets(Array("Print - Cover", "Print 2.2")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF,  Filename:=PDFFile,Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating

This saves sheets "Print - Cover" and "Print 2.2" to a PDF as intended. Instead of hardcoding the sheetnames, I would like to save whichever worksheets have a name that exists within a range of cells.

E.g. in cells A1:A3 of my ActiveSheet, I could have Bee, Cat and Dog, and the macro would

  • select worksheets "Bee", "Cat" and "Dog",
  • but not "Pig", which exists as a worksheet but isn't listed.

The number of sheets listed may increase or decrease.

The purpose of this is to allow users to easily indicate which sheets they would like saved without having to edit the macro.

2
excelvbapdfsaveworksheet

2 Answers

1
votes

I've use column B on Sheet1 starting in the second row for the list of worksheets to be exported to PDF.

Sub PDF_from_Range(Optional OpenPDFAfterCreating As Boolean = False)
    Dim v As Long, vWSs As Variant, PDFFile As String

    PDFFile = Environ("TEMP") & Chr(92) & "pdf_print_test"
    With Worksheets("Sheet1")
        ReDim vWSs(0)
        For v = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
            vWSs(UBound(vWSs)) = .Range("B" & v).Value2
            ReDim Preserve vWSs(0 To UBound(vWSs) + 1)
        Next v
        ReDim Preserve vWSs(0 To UBound(vWSs) - 1)
    End With
    Worksheets(vWSs).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=OpenPDFAfterCreating
End Sub

A one-dimensional array can easily take care of the collection of worksheet names. Error control could easily be brought in to make sure that the worksheets named in column B exists in the current workbook.

0
votes

Here is a simple way that includes error handling:

Sub PrintPDFs()
    Dim i&, n$, s$, v
    v = [a1:a3]
    On Error Resume Next
    For i = 1 To UBound(v)
        n = Worksheets(v(i, 1)).Name
        If Len(n) Then s = s & "," & n
        n = ""
    Next
    If Len(s) Then
        Worksheets(Split(Mid$(s, 2), ",")).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=OpenPDFAfterCreating
    End If
End Sub

Note: you can edit that list range at the top in the square brackets.