Reputation: 1
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
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
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