Question

我一直在尝试使用多种技术来解决这个问题而且遇到了一些麻烦。

背景：基本上我希望根据位于＆＃34;打印控件＆＃34;中的单元格的值将工作表导出为pdf。工作表。值是＆＃34; 1＆＃34;用于打印，＆＃34; 0＆＃34;不打印。

正如您将在下面看到的，我有两个数组。首先包含＆＃34;公司＆＃34;的列表，该值被替换为＆＃34; P 1＆＃34;中的单元格M1。工作表根据公司更改值。第二个数组包含需要打印的工作表列表。

本质上，我需要代码来检查是否应该打印工作表，将其添加到数组（或选择它），重复所有工作表，然后将数组（或选定的工作表）打印到pdf文件。完成后，我需要清空阵列并为下一家公司执行相同的过程。

我在If语句中遇到问题。我不确定实现这一目标的最有效方法是什么。使用下面发布的代码，我得到一个超出范围错误的下标。我希望得到一些输入来修复这段代码，或者提出一个更好的方法来做到这一点。

可以在If语句中看到工作表名称，我尝试将每个工作表保存到pagearray（）。

谢谢，

以下是我的工作内容：

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

Answer 1

未测试：

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

Answer 2

对于任何寻找类似解决方案的人来说，这就是我最终合作的方式：

' 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

使用数组选择多张纸进行打印

2 个答案: