使用Excel 2013 VBA从用户表单select生成多页报表

我有一个Excel 2013工作簿，可以捕捉大量有关不同设备的数据。 为了使input用户友好，它被分成两个工作表“设备”和“设备数据”。 设备是一个前端，以易于阅读/编辑/打印格式显示来自设备数据的数据。 Equipment-Data是由100个设备组成的85列数据的后端数据表。

导航是通过select驻留在用户窗体上的ListBox上的设备来执行的，该窗体允许他们在项目之间快速导航。 当列表框select更改时，数据表中相应的行将读取到数组并写入前端。 任何更改都会无缝地推回到数据表中。 基于最终用户的熟悉程度，Excelselect了Access，而两个工作表是一个不适合Access的大型工作簿的一部分。 此外，该工作簿支持一个交付物，不会长期更新。

我正在开发一种方法来收集所有的设备页面，并将它们导出到由Word和PDF混合构build的报告中（最终输出PDF）。 我确定有十几种方法可以做到这一点，但我想知道是否有一个更好的方法。 我还是比较新的VBA – 已经重写了这个项目上的代码，将子例程从表单移动到模块，在subs之间传递variables，而不是使用全局variables，读取/写入数组而不是循环遍历单元格，因为我学到了更好的方法做事。

我看到的方式是，我的select是：

1. 创build临时工作表，通过列表框循环，从前端复制范围，将特殊粘贴到临时工作表。 我从实验中发现，我需要将paste-first xlPasteColumnWidths，然后xlPasteValuesAndNumberFormats。 我尝试使用“值和源格式”（xlPasteAllUsingSourceTheme），但我得到一个关于合并单元格的错误。 第一次迭代之后，我可以用.PastereplacexlPasteColumnWidths，但仍然需要跟踪值和数字格式，因为有方程式。 粘贴后，跳过ListIndex * 78到下一页的开头并重复。 最后，将临时表导出为PDF并删除临时表。
2. 与＃1相同，但使用CopyPicture方法使用xlPicture获取向量输出。 循环后，导出到PDF并删除临时表。 这应该是在选项＃1的最终输出中不能区分的，不知道是否运行速度或内存100页图像的问题。
3. 在列表框中循环，使用ExportAsFixedFormat创build一个使用ListIndex＆Equipment_Name作为文件名的PDF。 然后使用外部PDF工具将文件合并为一个。
4. 创buildAccess数据库，使用设备数据表作为数据源，build立报表模拟设备表的格式。
5. 与1或2相同，但将每个ListItem复制到新工作表，select所有工作表，导出到pdf，删除工作表。

有没有更好的办法，我失踪了？ 我看到选项1和3是最好的追求。 3似乎是一个很好的快速修复，因为不太可能有其他人需要构build报告，但是对于将来可能在共享驱动器上find电子表格并希望在不同项目上重复使用的用户，1会更好。

Answer 1

我认为选项1将是最好的。 它给了你很大的灵活性，如果你以一种好的方式构build你的代码，维护起来也会很容易。 如果您在运行时禁用了屏幕更新，那么对于最终用户来说，这将非常顺利。
另一种可能性（自从你提到的Word）是可以从你的macros中创build一个Word文档。 只需在工具 – 参考下添加一个对“Microsoft Word nn.n对象库”的引用。 然后，您可以访问Word的对象模型，并可以从Excel数据创build文档。

Answer 2

我testing了选项1和2.选项1运行约30秒，使用另存为PDF（手动，还没有编码它），产生了一个2.3MB的PDF（95页）。 选项2在100秒内运行，生成1.0MB PDF。 两个PDF都是相似的，但是选项2显示了一个文本框，即使设置了CopyPicture方法的xlPrinter外观属性，该文本框也不会被打印。 保存选项1 temp工作表添加了500KB的xlsm文件，选项2只添加了115KB这是令人惊讶的。

下面的代码可能会在以后遇到这个问题：

Sub PrintEqEst() Dim tmpSht As Worksheet, EqSht As Worksheet Dim i as Long Dim TWB As Workbook PrintingReport = True 'Global boolean used to keep display updating from being turned back on in event routine Set TWB = ThisWorkbook Set EqSht=TWB.Worksheets("Equipment") Set cMyListBox2 = UserForm1.ListBox2 t(1) = timer *1000 If cMyListBox2.Rowsource = "" Then PopulateListBox Set tmpSht = TWB.Sheets.Add(After:=TWB.Sheets(TWB.Sheets.Count)) Application.ScreenUpdating = False For i = 0 to cMyListBox2.ListCount - 2 '-1 because it ListIndex starts at 0, -1 because there is intentional blank item at end of List DoEvents cMyListBox2.ListIndex = i 'Triggers event that updates Equipment Sheet EqSht.Range("C2:L73").Copy If i = 0 Then tmpSht.Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths tmpsht.Cells(77*i+1, 1).PasteSpecial Paste:=xlPasteAll tmpsht.Cells(77*i+1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Next i tmpSht.UsedRange.RowHeight = 11.25 If ListBox2Index >= 1 Then cMyListBox2.ListIndex = ListBox2Index 'If something previously selected, go back to it. (ListBox2Index is global that keeps track of selected item) With tmpSht.PageSetup [...] End With Application.ScreenUpdating=True PrintingReport=False Debug.Print "Create Report: " & Round(timer * 1000 - t(1), 0) & "ms" End Sub 

选项2使用以上代码，for循环使用除外：

 EqSht.Range("C2:L73").CopyPicture Appearance:=xlPrinter, Format:=xlPicture tmpSht.Cells(64 * i + 2, 1).Select tmpSht.Paste