olebev
olebev

Reputation: 1

Using an array to select multiple sheets for printing

I've been trying to solve this problem using several techniques and am having some trouble.

Background: Basically I am looking to export worksheets to a pdf based upon the value of a cell located in the "Print Control" worksheet. The value is "1" for print, and "0" for not to print.

As you will see below, I have two arrays. First contains a list of "companies", this value is substituted in to cell M1 in the "P 1" worksheet to change the values depending on the company. The second array contains the list of worksheets that need to be printed.

In essence, I need the code to check if the worksheet should be printed, add it to the array (or select it), repeat for all worksheets, then print the array (or selected worksheets) to a pdf file. Once complete, I need to empty the array and do the same process for the next company.

I am having issues in the If statements. I am not sure what the most efficient method is to achieve this. Using the code posted below, I get a subscript out of range error. I would love some input to either fix this code, or suggest a better way of doing this.

The worksheet names can be seen in the If statements where I attempt to save each worksheet to pagearray().

Thanks,

Here is what I am working with:

Sub PrintCopies()
    Dim i As Integer
    Dim VList As Variant
    Dim pagearray() As String

    VList = Array("Company 1", "Company 2", "Company 3")
    For i = LBound(VList) To UBound(VList)
        ActiveWorkbook.Sheets("P 1").Range("M1") = VList(i)

        If ActiveWorkbook.Sheets("Print Control").Range("C2") = "1" Then
        pagearray(0) = "P 1"
        pagearray(1) = "P 2"
        End If
        If ActiveWorkbook.Sheets("Print Control").Range("D2") = "1" Then
        pagearray(2) = "PQS 1"
        pagearray(3) = "PQS 2"
        End If
        If ActiveWorkbook.Sheets("Print Control").Range("E2") = "1" Then
        pagearray(4) = "C 1"
        pagearray(5) = "C 2"
        End If
        If ActiveWorkbook.Sheets("Print Control").Range("F2") = "1" Then
        pagearray(6) = "A 1"
        pagearray(7) = "A 2"
        End If
        If ActiveWorkbook.Sheets("Print Control").Range("G2") = "1" Then
        pagearray(8) = "AQS 1"
        pagearray(9) = "AQS 2"
        End If
        If ActiveWorkbook.Sheets("Print Control").Range("H2") = "1" Then
        pagearray(10) = "L 1"
        pagearray(11) = "L 2"
        End If
        If ActiveWorkbook.Sheets("Print Control").Range("I2") = "1" Then
        pagearray(12) = "LQS 1"
        pagearray(13) = "LQS 2"
        End If
        If ActiveWorkbook.Sheets("Print Control").Range("J2") = "1" Then
        pagearray(14) = "Cess 1"
        pagearray(15) = "Cess 2"
        End If

ThisWorkbook.Sheets(Array(pagearray())).Select

Application.Calculate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "U:\Test File\" & ActiveWorkbook.Sheets("P1").Range("M1").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
     IgnorePrintAreas:=False, OpenAfterPublish:=False
Application.Calculate
Application.Wait (Now + TimeValue("00:00:01"))

    Next
End Sub

Upvotes: 0

Views: 1519

Answers (2)

olebev
olebev

Reputation: 1

For anyone searching for a similar solution, this is what I ended up working with:

' Entryhook for the 'Print' button
Sub PrintDocument()
    Call PrintSingle
End Sub

Sub PrintSingle()
    Dim worksheets As Collection
    Set worksheets = GetWorksheets()

    Set prop2 = ActiveWorkbook.Sheets("Prop 2")

    Dim strFileName As String
    strFileName =  'Enter Path Here

    Call PrintDoc(strFileName, worksheets)
End Sub

' Entryhook for the 'Print All' button
Sub PrintAll()
    Set wrksht = ActiveWorkbook.Sheets("Print Control")
    Set prop2 = ActiveWorkbook.Sheets("Prop 2")
    For Each company In wrksht.Range("A4:A54").cells
        prop2.Range("M1").Value = company
        Application.Calculate
        Call PrintSingle
    Next
End Sub

' Prints a collection of worksheets as a PDF
' @param strFileName The name of the file
' @param worksheets The list of worksheets to print
Sub PrintDoc(strFileName As String, worksheets As Collection)
    Sheets(collectionToArray(worksheets)).Select
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=strFileName, _
       IgnorePrintAreas:=False
End Sub

' Gets the worksheets that need to be present for a given worksheet
' @param company The ID of the company
Function GetWorksheets() As Collection
    Dim switches As Collection
    Set switches = GetPrintSwitches()

    Dim wrksheets As Collection
    Set wrksheets = GetWorksheetMapping()

    Set wrksht = ActiveWorkbook.Sheets("Print Control")
    Set GetWorksheets = New Collection
    For Each pswitch In switches
        If wrksht.Range(pswitch) = "1" Then
            For Each doc In wrksheets.Item(pswitch)
                GetWorksheets.Add doc
            Next
        End If
    Next
End Function

' Gets a dictionary that maps a print switch to a list of worksheets to print
Function GetWorksheetMapping() As Collection
    Set GetWorksheetMapping = New Collection
    GetWorksheetMapping.Add Item:=Array("P1", "P2"), Key:="B1"
    GetWorksheetMapping.Add Item:=Array("P2"), Key:="C1"
    GetWorksheetMapping.Add Item:=Array("PQS 1"), Key:="D1"
    GetWorksheetMapping.Add Item:=Array("PQS 2"), Key:="E1"
    GetWorksheetMapping.Add Item:=Array("C1"), Key:="F1"
End Function

' Get a list of the cells to review for a print control
Function GetPrintSwitches() As Collection
    Set GetPrintSwitches = New Collection
    GetPrintSwitches.Add "B1"
    GetPrintSwitches.Add "C1"
    GetPrintSwitches.Add "D1"
    GetPrintSwitches.Add "E1"
    GetPrintSwitches.Add "F1"
End Function

Function collectionToArray(c As Collection) As Variant()
    Dim a() As Variant: ReDim a(0 To c.Count - 1)
    Dim i As Integer
    For i = 1 To c.Count
        a(i - 1) = c.Item(i)
    Next
    collectionToArray = a
End Function

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166136

Untested:

Sub PrintCopies()

    Dim wb As Workbook
    Dim i As Integer
    Dim VList As Variant
    Dim pages As String

    Set wb = ActiveWorkbook

    VList = Array("Company 1", "Company 2", "Company 3")

    For i = LBound(VList) To UBound(VList)
        ActiveWorkbook.Sheets("P 1").Range("M1") = VList(i)

        With wb.Sheets("Print Control")

            If .Range("C2") = "1" Then BuildString pages, "P 1|P 2"
            If .Range("D2") = "1" Then BuildString pages, "PQS 1|PQS 2"
            If .Range("E2") = "1" Then BuildString pages, "C 1|C 2"
            If .Range("F2") = "1" Then BuildString pages, "A 1|A 2"
            'etc etc

        End With

        If Len(pages) > 0 Then

            ThisWorkbook.Sheets(Split(pages, "|")).Select
            Application.Calculate
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                "U:\Test File\" & VList(i), _
                 Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                 IgnorePrintAreas:=False, OpenAfterPublish:=False
            Application.Calculate
            Application.Wait (Now + TimeValue("00:00:01"))

        End If

    Next i
End Sub

'ultility sub
Sub BuildString(ByRef str, addthis)
    str = str & IIf(Len(str) > 0, "|", "") & addthis
End Sub

Upvotes: 1

Related Questions