Excel VBA Barcode Generator

[Tetra201]

I encountered a need to generate barcodes from alphanumeric strings from within Excel (by the way, Word has a built-in capability for this). So I wrote a piece of VBA code shown below. It was inspired by the posts of yakovleff from this forum.

The resulting barcode is a group of rectangular shapes, so it can be handled as a single object – moved, rotated, etc. It can also be stretched/shrunk as needed without losing the barcode structure. The EncStr argument in the barcode drawing sub is a string of ones and zeros that can be generated by a desired encoding function. I am attaching my Code128B function as an example. Everything else is pretty much self-explanatory.

If you find this barcode generator useful, please provide a feedback.

Type BarParams
    Pos As Long
    Width As Byte
End Type
Sub DrawBarcode(EncStr As String, Left As Single, Top As Single, _
    SingleWidth As Single, Height As Single, Optional Color As Long)
'
' Parameters:
'
' EncStr - a string of ones and zeros, e.g., "11001011"
' Left - the position (in points) of the upper-left corner of the barcode
'        relative to the upper-left corner of the worksheet.
' Top - the position (in points) of the upper-left corner of the barcode
'       relative to the upper-left corner of the worksheet.
' SingleWidth - the width (in points) of a single-wide bar or space.
' Height - the height of the bars, in points.
' Color - (optional) the color of bars; if omitted, the color vill be black.
'
Dim TgtSht As Worksheet
Dim Bars() As BarParams
Dim NextBar As Boolean
Dim i, j As Long
Dim BarColl() As Variant
'
Set TgtSht = ActiveSheet
'
ReDim Bars(1 To 1)
Bars(1).Width = 0
NextBar = False
j = 1
'
For i = 1 To Len(EncStr) Step 1
    If Mid(EncStr, i, 1) = "1" Then
        If Not NextBar Then Bars(j).Pos = i
        Bars(j).Width = Bars(j).Width + 1
        NextBar = True
    Else
        If NextBar Then
            j = j + 1
            ReDim Preserve Bars(1 To j)
            Bars(j).Width = 0
        End If
        NextBar = False
    End If
Next i
'
ReDim BarColl(1 To j)
'
For i = 1 To j Step 1
    With TgtSht.Shapes.AddShape(msoShapeRectangle, _
        Left + (Bars(i).Pos - 1) * SingleWidth, Top, _
        Bars(i).Width * SingleWidth, Height)
        .Line.Visible = msoFalse
        .Fill.ForeColor.RGB = Color
        BarColl(i) = .Name
    End With
Next i
'
TgtSht.Shapes.Range(BarColl).Group
'
End Sub

Function Code128B(TxtStr As String) As String
'
' Parameters
'
' TxtSrt - an alphanumeric string; Chr(32) to Chr(106) can be used.
'
Const MaxChB = 94
'
Dim i, j As Long
Dim SymChB(0 To MaxChB) As String * 1
Dim SymEnc As Variant
Dim WgtSum As Long
Dim EncStr As String
'
For i = 0 To 94
    SymChB(i) = Chr(i + 32)
Next i
'
SymEnc = Array( _
    "11011001100", "11001101100", "11001100110", "10010011000", "10010001100", _
    "10001001100", "10011001000", "10011000100", "10001100100", "11001001000", _
    "11001000100", "11000100100", "10110011100", "10011011100", "10011001110", _
    "10111001100", "10011101100", "10011100110", "11001110010", "11001011100", _
    "11001001110", "11011100100", "11001110100", "11101101110", "11101001100", _
    "11100101100", "11100100110", "11101100100", "11100110100", "11100110010", _
    "11011011000", "11011000110", "11000110110", "10100011000", "10001011000", _
    "10001000110", "10110001000", "10001101000", "10001100010", "11010001000", _
    "11000101000", "11000100010", "10110111000", "10110001110", "10001101110", _
    "10111011000", "10111000110", "10001110110", "11101110110", "11010001110", _
    "11000101110", "11011101000", "11011100010", "11011101110", "11101011000", _
    "11101000110", "11100010110", "11101101000", "11101100010", "11100011010", _
    "11101111010", "11001000010", "11110001010", "10100110000", "10100001100", _
    "10010110000", "10010000110", "10000101100", "10000100110", "10110010000", _
    "10110000100", "10011010000", "10011000010", "10000110100", "10000110010", _
    "11000010010", "11001010000", "11110111010", "11000010100", "10001111010", _
    "10100111100", "10010111100", "10010011110", "10111100100", "10011110100", _
    "10011110010", "11110100100", "11110010100", "11110010010", "11011011110", _
    "11011110110", "11110110110", "10101111000", "10100011110", "10001011110", _
    "10111101000", "10111100010", "11110101000", "11110100010", "10111011110", _
    "10111101110", "11101011110", "11110101110", "11010000100", "11010010000", _
    "11010011100", "11000111010")
ReDim Preserve SymEnc(0 To 106)
'
WgtSum = 104 ' START-B
EncStr = EncStr + SymEnc(104)
For i = 1 To Len(TxtStr) Step 1
    j = 0
    Do While (Mid(TxtStr, i, 1) <> SymChB(j)) And (j <= MaxChB)
        j = j + 1
    Loop
    If j > MaxChB Then j = 0
    WgtSum = WgtSum + i * j
    EncStr = EncStr + SymEnc(j)
Next i
Code128B = EncStr + SymEnc(WgtSum Mod 103) + SymEnc(106) + "11"
'
End Function

 

[Bovinewaste]

Hi, This is great. I can get the function to work and produce the 1s and 0s but how can I get it to create the actual bars?

 

[Tetra201]

Running the following sub will create a barcode:

Sub Test()
    DrawBarcode Code128B("Test"), 10, 10, 1, 30
End Sub

 

[Gerald Higgins]

Hi, thanks very much for posting this, much appreciated !

I have a requirement to do this, i.e. generate EAN128 barcodes, from data held in a spreadsheet.

I'm afraid I don't understand at all how your code works.

Let's say I have a list of numbers in the range A1:A10, how would I adapt your code to generate a barcode for each one ?

Thanks in advance for any help !

 

[Tetra201]

The following simple sub will generate ten individual barcodes for numbers in the range A1:A10

Sub Test()
    Dim i As Long
    For i = 1 To 10
        DrawBarcode Code128B(Range("A" & i)), 100, 10 + (i - 1) * 40, 1, 20
    Next i
End Sub

However, you mentioned EAN128, and to my (limited) knowledge, EAN128 barcodes always contain a special non-printable/non-data character (FNC1), which still should be included in the check symbol calculation. So, if you want to generate EAN128 barcodes, you would need to modify the encoding function.

 

[Gerald Higgins]

Thanks very much Tetra201.

if you want to generate EAN128 barcodes, you would need to modify the encoding function.

Sorry for being useless, but any ideas how I might do the above, i.e. modify the encoding function for EAN128 ?

 

[Tetra201]

Hi Gerald,

If each of your EAN128 barcodes has only one FNC1 symbol, this should be an easy fix -- please try the following encoding function (please note that I have no means to test the functionality of the resulting barcodes):

Function CodeEAN128_1(TxtStr As String) As String
'
' Parameters
'
' TxtSrt - an alphanumeric string; Chr(32) to Chr(106) can be used.
'
Const MaxChB = 94
'
Dim i, j As Long
Dim SymChB(0 To MaxChB) As String * 1
Dim SymEnc As Variant
Dim WgtSum As Long
Dim EncStr As String
'
For i = 0 To 94
    SymChB(i) = Chr(i + 32)
Next i
'
SymEnc = Array( _
    "11011001100", "11001101100", "11001100110", "10010011000", "10010001100", _
    "10001001100", "10011001000", "10011000100", "10001100100", "11001001000", _
    "11001000100", "11000100100", "10110011100", "10011011100", "10011001110", _
    "10111001100", "10011101100", "10011100110", "11001110010", "11001011100", _
    "11001001110", "11011100100", "11001110100", "11101101110", "11101001100", _
    "11100101100", "11100100110", "11101100100", "11100110100", "11100110010", _
    "11011011000", "11011000110", "11000110110", "10100011000", "10001011000", _
    "10001000110", "10110001000", "10001101000", "10001100010", "11010001000", _
    "11000101000", "11000100010", "10110111000", "10110001110", "10001101110", _
    "10111011000", "10111000110", "10001110110", "11101110110", "11010001110", _
    "11000101110", "11011101000", "11011100010", "11011101110", "11101011000", _
    "11101000110", "11100010110", "11101101000", "11101100010", "11100011010", _
    "11101111010", "11001000010", "11110001010", "10100110000", "10100001100", _
    "10010110000", "10010000110", "10000101100", "10000100110", "10110010000", _
    "10110000100", "10011010000", "10011000010", "10000110100", "10000110010", _
    "11000010010", "11001010000", "11110111010", "11000010100", "10001111010", _
    "10100111100", "10010111100", "10010011110", "10111100100", "10011110100", _
    "10011110010", "11110100100", "11110010100", "11110010010", "11011011110", _
    "11011110110", "11110110110", "10101111000", "10100011110", "10001011110", _
    "10111101000", "10111100010", "11110101000", "11110100010", "10111011110", _
    "10111101110", "11101011110", "11110101110", "11010000100", "11010010000", _
    "11010011100", "11000111010")
ReDim Preserve SymEnc(0 To 106)
'
WgtSum = 104 + [COLOR=#FF0000]102[/COLOR] ' START-B, FNC1
EncStr = EncStr + SymEnc(104) + [COLOR=#FF0000]SymEnc(102)[/COLOR]
For i = 1 To Len(TxtStr) Step 1
    j = 0
    Do While (Mid(TxtStr, i, 1) <> SymChB(j)) And (j <= MaxChB)
        j = j + 1
    Loop
    If j > MaxChB Then j = 0
    WgtSum = WgtSum + (i [COLOR=#FF0000]+ 1[/COLOR]) * j
    EncStr = EncStr + SymEnc(j)
Next i
CodeEAN128_1 = EncStr + SymEnc(WgtSum Mod 103) + SymEnc(106) + "11"
'
End Function

 

[Gerald Higgins]

Thanks very much Tetra201, I can check the functionality of the barcode at this end.

I'll give it a go and let you know.

Cheers !

 

[Gerald Higgins]

Thanks again Tetra201, and apologies for the delay in responding.
I tried your modified code for EAN128, and it generated some barcodes - yay !
I'm not a barcode expert, but I can confirm that the system we are using here seems to recognise the output as EAN128 barcodes - yay2 !

But the best bit is, on checking all of this with our IT guy, it turns out we don't actually need EAN128, we needed Code128 all along !

So I'm afraid I won't be using the work you did on EAN128, at least for this application, but hopefully someone else will find it useful.

And in the meantime, I'm off back to look at your original work on Code128.

I'll let you know how I get on.

Thanks again !

 

[anman]

Thanks very much Tetra201

Why is the barcode generated by the online barcode generator relatively short?
Is there any way to get VBA Barcode Generator
Let it be shorter?