Question

我有以下工作代码循环遍历每个工作表，如果范围（myrange）中定义的值是＆＃39; Y＆＃39;，则将这些工作表输出到单个PDF文档中。我的挑战是，我想根据范围中的数字值（例如1,2,3,4,5,6,7等）来定义它们在PDF中输出的顺序，而不是＆＃39; Y＆＃39 ;.我打算在myrange中使用相同的列来检查是否需要输出到PDF，只需简单地交换＆＃39; Y＆＃39;对于一个数字，例如＆＃39; 1＆＃39;和＆＃39; 2＆＃39;。

目前，订单是根据工作表标签的位置定义的。从左到右。

非常感谢任何帮助。

Sub Run_Me_To_Create_Save_PDF()

    Dim saveAsName          As String
    Dim WhereTo             As String
    Dim sFileName           As String
    Dim ws                  As Worksheet
    Dim printOrder          As Variant '**added**
    Dim myrange

    On Error GoTo Errhandler

    Sheets("Settings").Activate

' Retrieve value of 'Period Header' from Settings sheet
    Range("C4").Activate
    periodName = ActiveCell.Value

' Retrieve value of 'File Name' from Settings sheet
    Range("C5").Activate
    saveAsName = ActiveCell.Value

' Retrieve value of 'Publish PDF to Folder' from Settings sheet
    Range("C6").Activate
    WhereTo = ActiveCell.Value

    Set myrange = Worksheets("Settings").Range("range_sheetProperties")

' Check if Stamp-field has any value at all and if not, add the current date.
    If Stamp = "" Then Stamp = Date

' Assemble the filename
    sFileName = WhereTo & saveAsName & " (" & Format(CDate(Date), "DD-MMM-YYYY") & ").pdf"

' Check whether worksheet should be output in PDF, if not hide the sheet
    For Each ws In ActiveWorkbook.Worksheets

        Sheets(ws.Name).Visible = True
        printOrder = Application.VLookup(ws.Name, myrange, 4, False)

        If Not IsError(printOrder) Then

            If printOrder = "Y" Then
                Sheets(ws.Name).Visible = True
            End If
            Else: Sheets(ws.Name).Visible = False
        End If

    Next

'Save the File as PDF
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    sFileName, Quality _
    :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True

' Unhide and open the Settings sheet before exiting
    Sheets("Settings").Visible = True
    Sheets("Settings").Activate
    MsgBox "PDF document has been created and saved to : " & sFileName

    Exit Sub

Errhandler:

' If an error occurs, unhide and open the Settings sheet then display an error message
    Sheets("Settings").Visible = True
    Sheets("Settings").Activate
    MsgBox "An error has occurred. Please check that the PDF is not already open."


End Sub

----------------------更新：-------------------- -----------------

感谢您到目前为止的所有输入。我确实让它短暂工作，但随着更多的游戏我被卡住了。我现在正在收到我们的范围＆＃39;以下代码出现错误：

If sheetNameArray(x) <> Empty Then

有什么想法吗？

        Sub Run_Me_To_Create_Save_PDF()

        Dim saveAsName                  As String
        Dim WhereTo                     As String
        Dim sFileName                   As String
        Dim ws                          As Worksheet
        Dim myrange
        ReDim sheetNameArray(0 To 5) As String
        Dim NextWs                      As Worksheet
        Dim PreviousWs                  As Worksheet
        Dim x                           As Integer

    'On Error GoTo Errhandler

        Sheets("Settings").Activate

    ' Retrieve value of 'Period Header' from Settings sheet
        Range("C4").Activate
        periodName = ActiveCell.Value

    ' Retrieve value of 'File Name' from Settings sheet
        Range("C5").Activate
        saveAsName = ActiveCell.Value

    ' Retrieve value of 'Publish PDF to Folder' from Settings sheet
        Range("C6").Activate
        WhereTo = ActiveCell.Value

    ' Check if Stamp-field has any value at all and if not, add the current date.
        If Stamp = "" Then Stamp = Date

    ' Assemble the filename
        sFileName = WhereTo & saveAsName & " (" & Format(CDate(Date), "DD-MMM-YYYY") & ").pdf"

        Set myrange = Worksheets("Settings").Range("range_sheetProperties")

        For Each ws In ActiveWorkbook.Worksheets

            printOrder = Application.VLookup(ws.Name, myrange, 4, False)

            If Not IsError(printOrder) Then
                printOrderNum = printOrder
                If printOrderNum <> Empty Then
    'Add sheet to array
                    num = printOrderNum - 1
                    sheetNameArray(num) = ws.Name
                End If
            End If

        Next

        MsgBox Join(sheetNameArray, ",")

'Order Tab sheets based on array
        x = 1
        Do While Count < 6
            If sheetNameArray(x) <> Empty Then

                Set PreviousWs = Sheets(sheetNameArray(x - 1))
                Set NextWs = Sheets(sheetNameArray(x))
                NextWs.Move after:=PreviousWs
                x = x + 1
            Else
                Count = Count + 1
                x = x + 1
            End If
        Loop

        Sheets(sheetNameArray).Select

    'Save the File as PDF
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFileName, Quality _
        :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    ' open the Settings sheet before exiting
        Sheets("Settings").Activate
        MsgBox "PDF document has been created and saved to : " & sFileName

        Exit Sub

Errhandler:

    ' If an error occurs, unhide and open the Settings sheet then display an error message
        Sheets("Settings").Visible = True
        Sheets("Settings").Activate
        MsgBox "An error has occurred. Please check that the PDF is not already open."


    End Sub

Answer 1

这是我提出的一些代码。基本上你会想要采取这种方法并使其适应你的特定需求，但总体思路应该有效！

Sub MovingPagesAccordingToNumberInRange()

    Dim ws As Worksheet
    Dim NextWs As Worksheet
    Dim PreviousWs As Worksheet
    Dim sheetNameArray(0 To 400) As String
    Dim i As Integer

    'This first loop is taking all of the sheets that have a number
    ' placed in the specified range (I used Cell A1 of each sheet)
    ' and it places the name of the worksheet into an array in the
    ' order that I want the sheets to appear. If I placed a 1 in the cell
    ' it will move the name to the 1st place in the array (location 0).
    ' and so on. It only places the name however when there is something
    ' in that range.

    For Each ws In Worksheets
        If ws.Cells(1, 1).Value <> Empty Then
            num = ws.Cells(1, 1).Value - 1
            sheetNameArray(num) = ws.Name
        End If
    Next

    ' This next section simply moves the sheets into their
    ' appropriate positions. It takes the name of the sheets in the
    ' previous spot in the array and moves the current spot behind that one.
    ' Since I didn't know how many sheets you would be using I just put
    ' A counter in the prevent an infinite loop. Basically if the loop encounters 200
    ' empty spots in the array, everything has probably been organized.
    x = 1
    Do While Count < 200
        If sheetNameArray(x) <> Empty Then

            Set PreviousWs = sheets(sheetNameArray(x - 1))
            Set NextWs = sheets(sheetNameArray(x))
            NextWs.Move after:=PreviousWs
            x = x + 1
        Else
            Count = Count + 1
            x = x + 1
        End If
    Loop
End Sub

Answer 2

您可能希望在数组中定义工作表。

此示例使用静态数组，了解工作表顺序以及您要提前打印的内容。这确实有效。

ThisWorkbook.Sheets(Array("Sheet1","Sheet2","Sheet6","Master","Sales")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=sFileName, Quality _
    :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True

问题是如果一张纸被隐藏，它将在选择时失败。

因此，在声明数组之前，您需要知道哪些工作表要通过测试才能打印。因此，您需要一个动态数组来构建工作表列表。

我确实改变了PrintOrder的工作方式，而不是让工作表不可见，它只是没有将它添加到数组中，反之亦然，将你想要的那些添加到数组中。然后在最后选择数组，并运行可行的打印宏。

我使用自己的测试值对此进行了测试，并且相信您的PrintOrder测试工作正常。但这确实有效。我用它来打印每天只有4个小时以上的时间表，并且它成功了，将一张工作簿中的5张合并为11张到一张PDF中。所有这些都符合测试条件。

TESTED：插入此而不是For Each ws并添加变量声明

Sub DynamicSheetArray()
    Dim wsArray() As String
    Dim ws As Worksheet
    Dim wsCount As Long

    wsCount = 0

    For Each ws In Worksheets
        printOrder = Application.VLookup(ws.Name, myrange, 4, False)
        If Not IsError(printOrder) Then
            If printOrder = "Y" Then
                wsCount = wsCount + 1
                ReDim Preserve wsArray(1 To wsCount)
                'Add sheet to array
                wsArray(wsCount) = ws.Name
            End If
        End If
    Next

    Sheets(wsArray).Select

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=sFileName, Quality _
        :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
End Sub

编辑：进一步解释了我的代码上下文OP

如何使用VBA以定义的顺序遍历工作表

2 个答案: