使用Excel 2013 VBA从用户表单选择构建多页报表

时间:2017-05-31 14:39:37

标签: excel excel-vba vba

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

通过选择驻留在UserForm上的ListBox上的设备来执行导航,该设备允许他们在项目之间快速导航。当ListBox选项发生更改时,数据表中的相应行将读取到数组并写入前端。任何更改都会无缝地推送回数据表。根据最终用户的熟悉程度选择Excel而不是Access,这两个工作表是一个不适合Access的大型工作簿的一部分。此外,该工作簿支持一个可交付成果,并且不会长期更新。

我正在开发一种收集所有设备页面并将其导出的方法,以便进入由Word和PDF混合构建的报告(最终输出PDF)。我确信有十几种方法可以做到这一点,但我想知道是否有更好的方法。我仍然相对较新的VBA - 已经重写了这个项目的代码,将子程序从工作表移动到模块,在subs之间传递变量而不是使用全局变量,读取/写入数组而不是循环遍历单元格,因为我学会了更好的方法做事。

我看到它的方式,我的选择是:

  1. 创建临时工作表,循环列表框,从前端复制范围,将特殊粘贴到临时表中。我从实验中发现,我需要先粘贴一次xlPasteColumnWidths然后xlPasteValuesAndNumberFormats。我尝试使用“值和源格式”(xlPasteAllUsingSourceTheme),但我收到有关合并单元格的错误。在第一次迭代之后,我可以用.Paste替换xlPasteColumnWidths,但仍然需要跟进值和&数字格式,因为有方程式。粘贴后,跳过ListIndex * 78以进入下一页的开头并重复。最后,将临时表导出为PDF并删除临时表。
  2. 与#1相同,但使用xlPicture的CopyPicture方法获取矢量输出。循环后,导出为PDF并删除临时表。这个应该在选项#1的最终输出中无法区分,不确定我是否会遇到100页图像的速度或内存问题。
  3. 循环浏览列表框并使用ExportAsFixedFormat以ListIndex& Equipment_Name作为文件名创建PDF。然后使用外部PDF工具将文件合并为一个。
  4. 创建Access数据库,使用Equipment-Data表作为数据源,并构建报告以模拟Equipment sheet的格式。
  5. 与1或2相同,但将每个ListItem复制到新工作表,选择所有工作表,导出为pdf,删除工作表。
  6. 有没有更好的方式让我失踪?我认为选项1和3是最好的选择。 3似乎是一个很好的快速修复,因为不太可能有其他人需要构建报告,但对于未来可能在共享驱动器上找到电子表格并希望在不同项目上重复使用它的用户来说,1会更好。 / p>

2 个答案:

答案 0 :(得分:1)

我认为选项1是最好的。它为您提供了很大的灵活性,如果您以良好的方式构建代码,它也很容易维护。如果在运行时禁用屏幕更新,对最终用户来说会非常顺利 另一种可能性(因为你提到Word)是可以从宏中创建Word文档。只需在工具 - 参考下添加对“Microsoft Word nn.n Object Library”的引用即可。然后,您可以访问Word的对象模型,并可以从Excel数据创建文档。

答案 1 :(得分:0)

我测试了选项1和2.选项1在大约30秒内运行,使用另存为..PDF(手动,尚未编码)产生2.3MB PDF(95页)。选项2在100秒内运行并生成1.0MB PDF。两个PDF都相似,但是选项2显示了一个文本框,即使设置了CopyPicture方法的xlPrinter外观属性,也设置为不打印。保存选项1临时工作表为xlsm文件添加了500KB,选项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