如何自动选择属于列表中每个项目的特定工作表并将它们导出到 pdf 文件

Question

我有以下问题需要在 Excel 中解决。我绝对不是 VBA 专家。但我喜欢用 VBA 发现编程并解决问题以使事情变得更容易。当然会有更好的设置方法，但这就是我所拥有的。

我有的我有一个包含几张纸的 Excel 工作簿。 “数据”、“计算”、“Frontpage”、“TemplateS”、“模板”等....

• 数据表有很多关于测试组成员的个人数据。
• Calc sheet 会进行一些创建个人结果所需的计算。
• 首页表包含一些个人数据，用于使报告更“专业”。
• 模板和模板表是不同报告的“模板”。这些模板将用于创建每个成员的个人报告。

我做了什么

1. 在我运行宏之前，我选择了我需要从中创建报告的模板（工作表）。
   • 接下来，宏 (Sub Make_Reports_sheets) 遍历成员列表并创建报告。对于每个报告，都会创建一个包含每个成员的个人数据的新表格。因此，可以根据我选择的模板数量为每个成员创建一个或多个报告（工作表）。工作表命名为：Member1_ReportA、Member1_ReportB、Member1_ReportC、Member2_ReportA、Member2_ReportB 等。
   2. 我已经有了创建 pdf 文件的宏。但是我仍然错了一段代码来实现我的目标。

   我想要达到的目标

   • 创建个人会员报告后，我想将它们导出为 pdf 文件。每个 pdf 文件都包含属于某个成员的报告。必须包括首页。

   我需要解决的是以下

   • 如何在创建报告后自动选择工作表。在其前面放置一个首页，然后将此选择导出为 pdf。然后继续下一个成员并再次做同样的事情，等等......

   有没有人有解决办法如何解决这个问题？非常感谢！ 最相关的代码和平在这里

   Sub Create_Report_Sheets()
       
       Dim SelectSheet As Object
       Dim ws As Worksheet
       Dim NewSheet As Worksheet   
       
       Dim ListOfNames As Range 'List can contain more than 50 members
       Dim Cell As Range
       
       Set Select.Sheet = ActiveWindow.SelectedSheets
       Set ListOfNames = DataSheet.Range(A1:A & LastRow)
       ...
       For Each Cell In ListOfNames
        For Each ws In SelectSheet
         ws.Copy After:=Sheets(Sheets.Count)
         Set NewSheet = ActiveSheet
         With NewSheet
          .Name = Cell.Offset(0,1) & "ReportA"
          'Do some stuff with this newsheet
         End With
        Next ws
       Next cell
   End Sub
       
   Sub Make_PDF()
       
       Dim ws As Worksheet
       Dim wb As Workbook
       Dim Frontpage As Worksheet
       Dim SelectSheet As Object
       Dim PathFile As String
       
       Set Frontpage = ThisWorkbook.Sheets("FrontPage")
       ...
       'How to automatically select the reports (sheets) that belongs to a member?
       'How to include a Frontpage as first page of the pdf file?
       ....
       With ws
        .Select
        .ExportAsFixedFormat _
        .Type:=xlTypePDF, _
        .FileName:=PathFile
       End With
       
   End Sub
   

   我必须对 SheetArray 和 ReDim 做些什么吗？我是否必须将我的两段代码组合在一起并一次处理所有代码？

Answer 1

这里肯定需要一个数组，所以你的假设是正确的:)

我希望在从我的 testSub 改回你的时我没有犯任何错误：

Sub Create_Report_Sheets()
    
    Dim SelectSheet As Object
    Dim ws As Worksheet, DataSheet As Worksheet
    Dim NewSheet As Worksheet
    Dim LastRow As Range
    Dim ListOfNames As Range 'List can contain more than 50 members
    Dim ccell As Range 'try not to use names used by excel/VBA as variable names
    Dim arrSheets As Variant
    Dim shAmount As Long
    Dim pathFile As String
    
    Set DataSheet = ThisWorkbook.Sheets("DataSheet")
    LastRow = DataSheet.Range("A" & Rows.Count).End(xlUp).Row 'fill your LastRow variable before using it
    Set SelectSheet = ActiveWindow.SelectedSheets 'Select.Sheet would throw an error here
    Set ListOfNames = DataSheet.Range("A1:A" & LastRow) 'don't forget your " with "A1:A"
    For Each ccell In ListOfNames
        shAmount = 1
        ReDim arrSheets(shAmount To shAmount)
        arrSheets(shAmount) = "FrontPage" 'put frontpage as your first element of your array
        For Each ws In SelectSheet
            ws.Copy After:=Sheets(Sheets.Count)
            Set NewSheet = ActiveSheet
            With NewSheet
             .Name = ccell.Offset(0, 1) & ws.Name 'if the names are in the A-column, why the offset? Probably also should use ws.Name instead of "ReportA"
             shAmount = shAmount + 1
             ReDim Preserve arrSheets(1 To shAmount) 'make Array bigger
             arrSheets(shAmount) = .Name
             'Do some stuff with this newsheet
            End With
        Next ws
        ThisWorkbook.Sheets(arrSheets).Select
        pathFile = ThisWorkbook.Path & " " & ccell.Offset(0, 1).Value2 & " Reports - " & Format(Now, "DD.MM.YYYY") & ".pdf"
         'adjust pathFile where needed
'~~~~ This will save over existing files with same name
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
            pathFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        Application.DisplayAlerts = False
 '       For i = 2 To UBound(arrSheets) 'uncomment the for loop if you want to delete the sheets after using them for the pdf file
 '       Sheets(arrSheets(i)).Delete
 '       Next i
        Application.DisplayAlerts = True
    Next ccell
End Sub

如果您还有其他问题，请随时提问。 另外：查看这篇文章以了解不同的方法：https://stackoverflow.com/a/36107539/19353309