插入形状变得越来越慢

Question

我制作带有嵌入式二维码的昆虫标本标签。博物馆馆长可以扫描同一组中一系列标本的二维码，进行数据操作。

二维码图像作为“形状”插入（我相信它们响应宏中的形状命令），由 Jiri Gabriel 通过 VBA 代码生成，由 Jonas Heidelberg (https://github.com/JonasHeidelberg/barcode-vba-macro-only) 编辑。

宏获取数据，用字符串和值填充单元格（即，打印在各个标签的人类可读部分上的内容）。插入所有打印文本后，宏会迭代地一次生成一个 QR 码图像，并将每个生成的图像放置在相应的人类可读标签旁边。

宏可以快速生成并插入前几张 QR 码图像，然后逐渐变慢。我推测是因为 Excel 不是为在同一个电子表格上处理大量高分辨率图像而构建的。我的工作表设计可容纳 220 个单独的 QR 码图像，但用 50 个 QR 码图像填充电子表格需要将近 10 分钟（填充 10 个 QR 码图像需要不到 30 秒的时间，因此速度下降很明显）。

我试过了：

1. 禁用屏幕更新 - 似乎不会提高处理速度

2. 将计算设置为手动 - 似乎不会提高处理速度

3. 生成每个 QR 码图像后，使用以下代码隐藏图像，然后在最后将所有图像变为可见 - 似乎有点帮助，但不足以使宏大规模可用。

   ActiveSheet.Shapes.SelectAll

   Selection.ShapeRange.Visible = False

我寻找解决方案，看看是否可以将 QR 码图像形状合并为一个形状，因为毕竟管理一个形状不是比 200 多个单独的小形状更容易吗？似乎没有将所有形状组合成一个形状的功能。

我想到的另一个解决方案是同时生成所有 QR 码，而不是迭代地生成，那么也许它不会出现由于必须保留所有先前渲染的形状而导致渲染缓慢的问题代码在它的记忆中。我还没有找到一种方法来编写代码，以使所有 QR 码图像形状都并行生成，而不是按顺序生成。

我玩弄的另一个解决方案是将形状粘贴为 PNG 或其他可能更容易处理的图像，但我会损失很多质量，这似乎很奇怪，因为 QR 码应该只是一个矩阵黑白细胞，对吧？为什么它们会失去这么多质量？

Answer 1

我会建议一种基于内置 MS Word 2013+ 功能 (https://support.microsoft.com/en-us/office/field-codes-displaybarcode-6d81eade-762d-4b44-ae81-f9d3d9e07be3) 的方法。下面是一个在 10.6 秒内生成 200 个二维码的例子：

Option Explicit

Sub MakeQRcodes()
    Const QR_COUNT = 200
    Dim fld As Field, tbl As Table, rng As Range
    Dim Code As String, i As Integer, t As Single
    
    t = Timer
    
    ThisDocument.Range.Delete
    
    Set tbl = ThisDocument.Tables.Add(Range:=Selection.Range, NumRows:=QR_COUNT, NumColumns:= _
        2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed)
    
    For i = 1 To QR_COUNT
        Code = "Insect #" & i   ' data can be obtained from Excel spreadsheet
        tbl.Cell(i, 1).Range.Text = "QR code for [" & Code & "]:"
        
        Set rng = tbl.Cell(i, 2).Range
        rng.Collapse Direction:=wdCollapseStart
        
        Set fld = ThisDocument.Fields.Add(Range:=rng, Type:=wdFieldEmpty, _
            Text:="DisplayBarcode """ & Code & """ QR \q 3")
    Next i
    
    ThisDocument.ActiveWindow.View.ShowFieldCodes = False
    
    With tbl.Range
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .Cells.VerticalAlignment = wdCellAlignVerticalCenter
    End With
    
    Debug.Print "Done " & QR_COUNT & " items in " & Timer - t & " seconds"
End Sub

' Done 200 items in 10,62109 seconds

结果：

Edit2（VBA Excel 代码） 请注意，根据我的经验，DisplayBarcode 字段仅适用于拉丁字母。如果您有其他符号，请检查实际行中的代码。

Option Explicit

Sub makeQRs()
    Dim arr
    arr = ThisWorkbook.Sheets("Sheet1").ListObjects("Table1").DataBodyRange.Columns(3)
    Call MakeQRcodes(arr)
End Sub

Sub MakeQRcodes(arr) ' arr(n,1)
    'you need to add a reference to the "Microsoft Word Object Library" in the Tools-References VBE menu
    Dim wd As New Word.Application, doc As Word.Document, fld As Word.Field, tbl As Word.Table, rng As Word.Range
    Dim Code As String, i As Integer, QR_count As Integer, t As Single
    QR_count = UBound(arr, 1)
    
    t = Timer
    wd.Visible = False          ' hide the Word app
    Set doc = wd.Documents.Add  ' create a new Word document
    
    Set tbl = doc.Tables.Add(Range:=doc.Range, NumRows:=QR_count, _
              NumColumns:=2, DefaultTableBehavior:=1) 'wdWord9TableBehavior = 1
    
    For i = 1 To QR_count
        Code = arr(i, 1)
        tbl.Cell(i, 1).Range.Text = "QR code for [" & Code & "]:"
        
        Set rng = tbl.Cell(i, 2).Range
        rng.Collapse Direction:=wdCollapseStart
        
        Set fld = doc.Fields.Add(Range:=rng, Type:=-1, _
            Text:="DisplayBarcode """ & Code & """ QR \q 3")
    Next i
    
    doc.ActiveWindow.View.ShowFieldCodes = False
    
    With tbl.Range  ' center text and QR-code in the table cells
        .ParagraphFormat.Alignment = 1  'wdAlignParagraphCenter
        .Cells.VerticalAlignment = 1    'wdCellAlignVerticalCenter
    End With
    
    Application.DisplayAlerts = 0   'wdAlertsNone
    With doc
        ' save the Word doc as .pdf in the same folder as this Excel workbook
        .SaveAs2 ThisWorkbook.Path & "\QR.pdf", 17    'wdFormatPDF
        .Close False    ' close Word document without saving
        wd.Quit    ' close Word app
    End With
    Application.DisplayAlerts = -1  'wdAlertsAll
    
    MsgBox "Done " & QR_count & " QR-codes in " & Round(Timer - t, 1) & " seconds," & vbLf _
           & "saved in " & ThisWorkbook.Path & "\QR.pdf"
End Sub

数据和结果消息框

QR.pdf