Inserting shapes gets progressively slower

Question

I make entomological specimen labels that come with an embedded QR code. Museum curators can scan the QR codes of a series of specimens in the same group and manipulate data.

The QR code images are inserted as "shapes" (I believe--they respond to shape commands in the macro), generated via VBA code by Jiri Gabriel, with editing by Jonas Heidelberg (https://github.com/JonasHeidelberg/barcode-vba-macro-only).

The macro takes data, populates cells with strings and values (i.e., what gets printed on the human-readable part of the individual labels). When all of the printed text is inserted, the macro iteratively generates one QR code image at a time and places each generated image next to the corresponding human-readable label.

The macro is quick to generate and insert the first few QR code images then gets progressively slower. I presume because Excel is not built to handle a large number of high-resolution images on the same spreadsheet. My sheet design accommodates 220 individual QR code images, but it takes nearly 10 minutes to populate the spreadsheet with 50 QR code images (it takes less than 30 seconds to populate 10 QR code images, so the slowdown is appreciable).

I have tried:

Disable screen updating - does not seem to improve the processing speed
Set calculation to manual - does not seem to improve the processing speed
After generating each QR code image, hide the image by using the following code, and then at the very end, turn all the images visible - seems to help a little bit but not nearly sufficient to make the macro usable at scale.

ActiveSheet.Shapes.SelectAll

Selection.ShapeRange.Visible = False

I looked for solutions to see if the QR code image shapes can be merged into one shape, because after all, wouldn't it be easier to manage a single shape than 200+ individual small shapes? There seems to be no functionality to combine all of the shapes into a single shape.

Another solution I thought about is simultaneously generating all of the QR codes, instead of iteratively, then perhaps it won't have the issue of the later-coming shapes being slow to render due to having to hold all of the previously rendered codes in its memory. I haven't found a way to write the code such that all QR code image shapes are generated in parallel, rather than in sequence.

Another solution I toyed with is to paste the shapes as PNG or some other image that could potentially be easier to deal with, but I get a lot of loss of quality, which seems strange because the QR code should be just a matrix of black and white cells, right? Why do they lose so much quality?

user_15035314 · Answer

I would suggest an approach based on built in MS Word 2013+ feature (https://support.microsoft.com/en-us/office/field-codes-displaybarcode-6d81eade-762d-4b44-ae81-f9d3d9e07be3). Below is an example of generating 200 QR codes in 10.6 seconds:

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

Result:

Edit2 (VBA Excel code) Please note that in my experience the DisplayBarcode field works well only with the Latin alphabet. If you have other symbols, check the code on real lines.

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

Data & result MsgBox

QR.pdf

Inserting shapes gets progressively slower

1 Answers