Excel VBA Barcode Generator

Tetra201

MrExcel MVP
Joined
Oct 14, 2016
Messages
4,017
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.

Code:
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

Code:
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
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
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?
 
Upvote 0
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 !
 
Upvote 0
The following simple sub will generate ten individual barcodes for numbers in the range A1:A10
Code:
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.
 
Upvote 0
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 ?
 
Upvote 0
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):
Code:
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
 
Upvote 0
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 !
 
Upvote 0
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 !
 
Upvote 0
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?
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,215
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top