DataMatrix barcode support - trigger via VBA rather than formula

819 Views Asked by At

I found this excellent bit of code via this question in Patratacus answer; Generating 2D (PDF417 or QR) barcodes using Excel VBA

However the code is very much beyond me and i'm having inconsistent issues when producing a data matrix barcode label which i'm fairly sure is due to timing (every 4th or so barcode is scanning with the details of the product before it).

I believe this is because the code is getting a value, putting it into a named range which is then index / matching some values into other cells and text joining them to generate the barcode's value. I think this could be resolved if I call the barcode update via VBA after the subroutine is finished rather than using the formula to generate it which is happening as soon as the first value is updated.

The code has a built in way to trigger the QR barcode type but not for Data Matrix.

Sub Test_RenderQRCode()
    Call RenderQRCode(Application.ActiveSheet.Name, "A2", "Hello World", "mode=M", False)
End Sub

Would anyone be able to provide me with how to do that for the DM format please?

I honestly can't even figure out how to begin to do this with the code. I tried using optimization code (e.g. disabling application updates , calculations etc.) in my code that is firing the barcode upon a cell value change but it did not resolve the issue.

1

There are 1 best solutions below

0
On

For a DataMatrix it could be something like that:

Sub Test_RenderDMXCode()
   Call RenderDMXCode(Application.ActiveSheet.Name, "A2", "Hello World", True) 
End Sub

Public Sub RenderDMXCode(workSheetName As String, cellLocation As String, textValue As String, Optional addLabel As Boolean)
   Dim s_param As String
   Dim s_encoded As String
   Dim xSheet As Worksheet
   Dim QRShapeName As String
   Dim QRLabelName As String

   s_encoded = dmx_gen(textValue, "")
   Call DrawQRCode(s_encoded, workSheetName, cellLocation)

   Set xSheet = Worksheets(workSheetName)
   QRShapeName = "BC" & "$" & Left(cellLocation, 1) _
       & "$" & Right(cellLocation, Len(cellLocation) - 1) & "#GR"

   QRLabelName = QRShapeName & "_Label"

   With xSheet.Shapes(QRShapeName)
       .Width = 25
       .Height = 25
   End With

   On Error Resume Next
   If Not (xSheet.Shapes(QRLabelName) Is Nothing) Then
       xSheet.Shapes(QRLabelName).Delete
   End If

'Additonal text on right
   If IsMissing(addLabel) Then
      addLabel = True
   End If
   If addLabel Then
       xSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
           xSheet.Shapes(QRShapeName).Left + 35, _
           xSheet.Shapes(QRShapeName).Top, _
           Len(textValue) * 6, 30) _
           .Name = QRLabelName
    
    
       With xSheet.Shapes(QRLabelName)
           .Line.Visible = msoFalse
           .TextFrame2.TextRange.Font.Name = "Arial"
           .TextFrame2.TextRange.Font.Size = 9
           .TextFrame.Characters.text = textValue
           .TextFrame2.VerticalAnchor = msoAnchorMiddle
       End With
   End If
End Sub

The sub "RenderQRCode" remain the same as described on Generating 2D (PDF417 or QR) barcodes using Excel VBA