Code 93 barcode generator in VBA

Y

yakovleff

New Member
Joined
May 20, 2013
Messages
41
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
Hello All,

I've recently created a simple sub for Code 93 barcode drawing for a small project at my job. Want to share it with other Mr.Excel users and Google searchers. :)

Main features:
- Main symbology has been picked from CODE 93 SYMBOLOGY;
- The sub uses Shapes collection to draw lines of a barcode instead of special fonts;
- Sub draws a barcode onto a target Worksheet from beginning position which is defined by horizontal offset (X), vertical offset (Y) measured in mm of required height in mm; bar width is defined in pt;

Weaknesses/incompletenesses:
- Code contains main symbols only (values 0 to 46);
- If a symbol is out of the symbol list the sub ends without any message;
- Code does not check the length of the encoded string; if it is more that 20 chars a barcode is encoded wrongly.
- A complete barcode width is not pre-calulated and drawing begins from left which can cause unexpected overhangs;
- Sub does not support a barcode inclination; just vertical orientation
- Using Shapes collection increases a workbook size significantly.
- A barcode position is only correct when 100% print size is set.
- Obviously version-depended code (different versions/OSs/printers can vary the result, NOT tested).

Win 7 Ultimate, MS Office 2007 were used.
So, the main code is:

Code: 
Sub Code93Generate(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, TargetSheet As Worksheet, ByVal Content As String)
' X in mm
' Y in mm
' Height in mm
' LineWeight in pt
' Content  = encoded string


Dim SSSymbol As String 'start/stop symbol
Const Tbar_Symbol As String = "1" 'termination bar


Dim CurBar As Integer ' current running bar in a barcode
Dim SymbolChar(0 To 46) As String * 1 'encoded characters
Dim SymbolValue(0 To 46) As Integer ' character values
Dim SymbolString(0 To 46) As String * 9 ' "bit" sequence for each character
Dim C_WeightSum As Single
Dim K_WeightSum As Single
Dim C_CheckSum As Integer 'C checksum
Dim K_CheckSum As Integer 'K checksum
Dim ContentString As String 'bit sequence of whole barcode to be drawed
Dim i, j, k As Integer 'cycles indexes


SSSymbol = "101011110"


For i = 0 To 46
    SymbolValue(i) = i
Next i
For i = 0 To 9 'digits
    SymbolChar(i) = i
Next i
For i = 10 To 35 'digits
    SymbolChar(i) = Chr(i + 55)
Next i
SymbolChar(36) = "-"
SymbolChar(37) = "."
SymbolChar(38) = " "
SymbolChar(39) = "$"
SymbolChar(40) = "/"
SymbolChar(41) = "+"
SymbolChar(42) = "%"
SymbolChar(43) = "$"
SymbolChar(44) = "%"
SymbolChar(45) = "/"
SymbolChar(46) = "+"


SymbolString(0) = "100010100"
SymbolString(1) = "101001000"
SymbolString(2) = "101000100"
SymbolString(3) = "101000010"
SymbolString(4) = "100101000"
SymbolString(5) = "100100100"
SymbolString(6) = "100100010"
SymbolString(7) = "101010000"
SymbolString(8) = "100010010"
SymbolString(9) = "100001010"
SymbolString(10) = "110101000"
SymbolString(11) = "110100100"
SymbolString(12) = "110100010"
SymbolString(13) = "110010100"
SymbolString(14) = "110010010"
SymbolString(15) = "110001010"
SymbolString(16) = "101101000"
SymbolString(17) = "101100100"
SymbolString(18) = "101100010"
SymbolString(19) = "100110100"
SymbolString(20) = "100011010"
SymbolString(21) = "101011000"
SymbolString(22) = "101001100"
SymbolString(23) = "101000110"
SymbolString(24) = "100101100"
SymbolString(25) = "100010110"
SymbolString(26) = "110110100"
SymbolString(27) = "110110010"
SymbolString(28) = "110101100"
SymbolString(29) = "110100110"
SymbolString(30) = "110010110"
SymbolString(31) = "110011010"
SymbolString(32) = "101101100"
SymbolString(33) = "101100110"
SymbolString(34) = "100110110"
SymbolString(35) = "100111010"
SymbolString(36) = "100101110"
SymbolString(37) = "111010100"
SymbolString(38) = "111010010"
SymbolString(39) = "111001010"
SymbolString(40) = "101101110"
SymbolString(41) = "101110110"
SymbolString(42) = "110101110"
SymbolString(43) = "100100110"
SymbolString(44) = "111011010"
SymbolString(45) = "111010110"
SymbolString(46) = "100110010"


X = X / 0.376042 'mm to pt, measured by printing test lines onto an A4 page, can be different on each PC/printer. 
Y = Y / 0.341 'mm to pt, measured by printing test lines onto an A4 page. 
'Dont really know WHY X and Y factors are different, however they are...
Height = Height / 0.341 'mm to pt
Content = UCase(Content) ' UCase is used to make all symbols encodable


'C checksum counting
For i = 1 To Len(Content)
    j = -1
    Do ' searching for a character value 
        If j > 46 Then Exit Sub 'if an unlisted char is met exits Sub!
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    C_WeightSum = C_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i)
Next i
C_CheckSum = C_WeightSum Mod 47


Content = Content + SymbolChar(C_CheckSum)


'K checksum counting
For i = 1 To Len(Content)
    j = -1
    Do ' searching for a character value 
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    K_WeightSum = K_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i)
Next i
K_CheckSum = K_WeightSum Mod 47


Content = Content + SymbolChar(K_CheckSum)
ContentString = SSSymbol


For i = 1 To Len(Content)
   j = -1
    Do ' searching for each symbol in a sequence
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    ContentString = ContentString + SymbolString(j)
Next i
ContentString = ContentString + SSSymbol + Tbar_Symbol


'Barcode drawing
CurBar = 1


For i = 1 To Len(ContentString)
    Select Case Mid(ContentString, i, 1)
    Case 0
        CurBar = CurBar + 1
    Case 1
        CurBar = CurBar + 1
        TargetSheet.Shapes.AddLine X + CurBar * LineWeight, Y, X + CurBar * LineWeight, (Y + Height)
        TargetSheet.Shapes(ActiveSheet.Shapes.Count).Line.Weight = LineWeight
        TargetSheet.Shapes(ActiveSheet.Shapes.Count).Line.ForeColor.RGB = vbBlack ' each Excel version has its own default color so it is set forcibly
    End Select
Next i

End Sub

Barcode reading has been tested on an Android phone (Accusoft Barcode Scanner program) as well as on a PROTON IMS-3100 hardware wireless scanner.

Hope it would be of any help to anybody :)

Regards,
Yakovleff
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Update:
I have tested this sub moving barcodes to another workbook. New workbook size is acceptable (48 kB for 15 barcodes + few data in cells, xls, Excel 2007).
So
- Using Shapes collection increases a workbook size significantly.
Click to expand...
claim is not valid :)

Yakovleff
 
Upvote 0
Hi here,

2 news/updates for the topic.
1. I've recently had a feedback that the barcodes generated by the function are being read bad. They are read well from relatively big distance from the label which is not always convenient.
As I found the reason is the Excel (2007 in my case) prints lines with a small margin (about 0.1-0.05 mm, it's easily seen) which is an obstacle for a scanner to decode a barcode correctly. So the first fix is that bars are now closer to each other by 10%. This amount is found experimentally as the best for my PROTON. Feel free to find yours!
2. When the bars are located on the same sheet as other elements (buttons for activating macros and similar) bar weights and colors are not set correctly. It has been also fixed with another method of drawing the bars.
Both of fixes are located in the following fragment:
Code: 
       [COLOR=#ff0000] With TargetSheet.Shapes.AddLine[/COLOR](X + [COLOR=#ff0000](CurBar * LineWeight) * 0.9[/COLOR], Y, X + [COLOR=#ff0000](CurBar * LineWeight) * 0.9[/COLOR], (Y + Height)).Line
[COLOR=#ff0000]        .Weight = LineWeight
        .ForeColor.RGB = vbBlack
        End With[/COLOR]


So whole code is now as follows (fixes are highlighted):
Code: 
Sub Code93Generate(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, _
                  ByRef TargetSheet As Worksheet, ByVal Content As String)
' X in mm (0.376042)
' Y in mm (0.341)
' Height in mm
' LineWeight in pt

Dim SSSymbol As String
Const Tbar_Symbol As String = "1"

Dim CurBar As Integer
Dim SymbolChar(0 To 46) As String * 1
Dim SymbolValue(0 To 46) As Integer
Dim SymbolString(0 To 46) As String * 9
Dim C_WeightSum As Single
Dim K_WeightSum As Single
Dim C_CheckSum As Integer
Dim K_CheckSum As Integer 
Dim ContentString As String
Dim i, j, k As Integer

SSSymbol = "101011110"

For i = 0 To 46
    SymbolValue(i) = i
Next i
For i = 0 To 9 'digits
    SymbolChar(i) = i
Next i
For i = 10 To 35 'digits
    SymbolChar(i) = Chr(i + 55)
Next i
SymbolChar(36) = "-"
SymbolChar(37) = "."
SymbolChar(38) = " "
SymbolChar(39) = "$"
SymbolChar(40) = "/"
SymbolChar(41) = "+"
SymbolChar(42) = "%"
SymbolChar(43) = "$"
SymbolChar(44) = "%"
SymbolChar(45) = "/"
SymbolChar(46) = "+"

SymbolString(0) = "100010100"
SymbolString(1) = "101001000"
SymbolString(2) = "101000100"
SymbolString(3) = "101000010"
SymbolString(4) = "100101000"
SymbolString(5) = "100100100"
SymbolString(6) = "100100010"
SymbolString(7) = "101010000"
SymbolString(8) = "100010010"
SymbolString(9) = "100001010"
SymbolString(10) = "110101000"
SymbolString(11) = "110100100"
SymbolString(12) = "110100010"
SymbolString(13) = "110010100"
SymbolString(14) = "110010010"
SymbolString(15) = "110001010"
SymbolString(16) = "101101000"
SymbolString(17) = "101100100"
SymbolString(18) = "101100010"
SymbolString(19) = "100110100"
SymbolString(20) = "100011010"
SymbolString(21) = "101011000"
SymbolString(22) = "101001100"
SymbolString(23) = "101000110"
SymbolString(24) = "100101100"
SymbolString(25) = "100010110"
SymbolString(26) = "110110100"
SymbolString(27) = "110110010"
SymbolString(28) = "110101100"
SymbolString(29) = "110100110"
SymbolString(30) = "110010110"
SymbolString(31) = "110011010"
SymbolString(32) = "101101100"
SymbolString(33) = "101100110"
SymbolString(34) = "100110110"
SymbolString(35) = "100111010"
SymbolString(36) = "100101110"
SymbolString(37) = "111010100"
SymbolString(38) = "111010010"
SymbolString(39) = "111001010"
SymbolString(40) = "101101110"
SymbolString(41) = "101110110"
SymbolString(42) = "110101110"
SymbolString(43) = "100100110"
SymbolString(44) = "111011010"
SymbolString(45) = "111010110"
SymbolString(46) = "100110010"

X = X / 0.376042 'mm to pt
Y = Y / 0.341 'mm to pt
Height = Height / 0.341 'mm to pt
Content = UCase(Content)

'C checksum counting
For i = 1 To Len(Content)
    j = -1
    Do 
        If j > 46 Then Exit Sub
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    C_WeightSum = C_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i)
Next i
C_CheckSum = C_WeightSum Mod 47

Content = Content + SymbolChar(C_CheckSum)

'K checksum counting
For i = 1 To Len(Content)
    j = -1
    Do 
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    K_WeightSum = K_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i)
Next i
K_CheckSum = K_WeightSum Mod 47

Content = Content + SymbolChar(K_CheckSum)
ContentString = SSSymbol

For i = 1 To Len(Content)
   j = -1
    Do 
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    ContentString = ContentString + SymbolString(j)
Next i
ContentString = ContentString + SSSymbol + Tbar_Symbol

'Barcode drawing
[COLOR=#ff0000]CurBar = 0[/COLOR]

For i = 1 To Len(ContentString)
    Select Case Mid(ContentString, i, 1)
    Case 0
        CurBar = CurBar + 1
    Case 1
        CurBar = CurBar + 1
       [COLOR=#ff0000] With TargetSheet.Shapes.AddLine[/COLOR](X + [COLOR=#ff0000](CurBar * LineWeight) * 0.9[/COLOR], Y, X + [COLOR=#ff0000](CurBar * LineWeight) * 0.9[/COLOR], (Y + Height)).Line
[COLOR=#ff0000]        .Weight = LineWeight
        .ForeColor.RGB = vbBlack
        End With[/COLOR]
    End Select
Next i

End Sub


Welcome to post feedbacks!
 
Upvote 0
Hello again,
Would like to apologise for a weakness of the code revealed recently. I've received claims from users who scanned the barcodes. They claimed some barcodes were unreadable by any means. I began to study the case and found a great fault in encoding which led to those cases.
The fault was in encoding of the symbols of values 43-46. The BARCODE ISLAND - A website with technical information about bar codes says the following about those symbols:
Note that the characters ($), (%), (/), and (+) are special characters that are used to encode all 128 ASCII characters using Code 93's Full ASCII mode.

In Code 39, four of the characters ($, %, /, and +) are used to optionally encode all 128 characters-but there is no way to know whether those characters are being used as shift characters in Full ASCII mode or whether they are being used to represent $, %, /, and +. In Code 93 this problem is solved by reserving these four special characters exclusively to "shift" into Full ASCII mode.
Click to expand...
I've searched through all known sources where ASCII codes are published and didn't find any reference for the ASCII codes for those "magic" characters. I used the same symbols as for symbols of values 39-42:
SymbolChar(39) = "$"
SymbolChar(40) = "/"
SymbolChar(41) = "+"
SymbolChar(42) = "%"
SymbolChar(43) = "$"
SymbolChar(44) = "%"
SymbolChar(45) = "/"
SymbolChar(46) = "+"
Click to expand...
This led to incorrect checksum encoding and a scanner read chars 39-42 and was not able to decode the encoded string.
This issue was fixed with a tweak: I used the symbols NOT included into the Code93 symbology standard:
SymbolChar(43) = Chr(60)
SymbolChar(44) = Chr(61)
SymbolChar(45) = Chr(62)
SymbolChar(46) = Chr(63)
Click to expand...
Actually these symbols are used just for references for bit sequences and do not encode any readable symbol. Thanks to this tweak the code began to generate correct barcodes.
Besides C and K checksums calculating algorithms were adjusted in accordance with standard:
The "C" checksum character is the modulo 47 remainder of the sum of the weighted value of the data characters. The weighting value starts at "1" for the right-most data character, 2 for the second to last, 3 for the third-to-last, and so on up to 20. After 20, the sequence wraps around back to 1.
The "K" checksum character is calculated in basically the same way except that the weighting goes from 1 to 15. Also, the right-most character is now the "C" checksum character which was calculated in the step above.
Click to expand...

So, the final version:
Code: 
Sub Code93Generate(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, _
                  ByRef TargetSheet As Worksheet, ByVal Content As String)
' X in mm (0.376042)
' Y in mm (0.341)
' Height in mm
' LineWeight in pt

Dim SSSymbol As String
Const Tbar_Symbol As String = "1"

Dim CurBar As Integer
Dim SymbolChar(0 To 46) As String
Dim SymbolValue(0 To 46) As Integer
Dim SymbolString(0 To 46) As String * 9
Dim C_WeightSum As Single
Dim C_WeightIndex, K_WeightIndex As Integer 'weight indexes
Dim K_WeightSum As Single
Dim C_CheckSum As Single 
Dim K_CheckSum As Single
Dim ContentString As String
Dim i, j, k As Integer

SSSymbol = "101011110"

For i = 0 To 46
    SymbolValue(i) = i
Next i
For i = 0 To 9 'digits
    SymbolChar(i) = i
Next i
For i = 10 To 35 'digits
    SymbolChar(i) = Chr(i + 55)
Next i
SymbolChar(36) = "-"
SymbolChar(37) = "."
SymbolChar(38) = " "
SymbolChar(39) = "$"
SymbolChar(40) = "/"
SymbolChar(41) = "+"
SymbolChar(42) = "%"
[COLOR=#ff0000]SymbolChar(43) = Chr(60)
SymbolChar(44) = Chr(61)
SymbolChar(45) = Chr(62)
SymbolChar(46) = Chr(63)[/COLOR]

SymbolString(0) = "100010100"
SymbolString(1) = "101001000"
SymbolString(2) = "101000100"
SymbolString(3) = "101000010"
SymbolString(4) = "100101000"
SymbolString(5) = "100100100"
SymbolString(6) = "100100010"
SymbolString(7) = "101010000"
SymbolString(8) = "100010010"
SymbolString(9) = "100001010"
SymbolString(10) = "110101000"
SymbolString(11) = "110100100"
SymbolString(12) = "110100010"
SymbolString(13) = "110010100"
SymbolString(14) = "110010010"
SymbolString(15) = "110001010"
SymbolString(16) = "101101000"
SymbolString(17) = "101100100"
SymbolString(18) = "101100010"
SymbolString(19) = "100110100"
SymbolString(20) = "100011010"
SymbolString(21) = "101011000"
SymbolString(22) = "101001100"
SymbolString(23) = "101000110"
SymbolString(24) = "100101100"
SymbolString(25) = "100010110"
SymbolString(26) = "110110100"
SymbolString(27) = "110110010"
SymbolString(28) = "110101100"
SymbolString(29) = "110100110"
SymbolString(30) = "110010110"
SymbolString(31) = "110011010"
SymbolString(32) = "101101100"
SymbolString(33) = "101100110"
SymbolString(34) = "100110110"
SymbolString(35) = "100111010"
SymbolString(36) = "100101110"
SymbolString(37) = "111010100"
SymbolString(38) = "111010010"
SymbolString(39) = "111001010"
SymbolString(40) = "101101110"
SymbolString(41) = "101110110"
SymbolString(42) = "110101110"
SymbolString(43) = "100100110"
SymbolString(44) = "111011010"
SymbolString(45) = "111010110"
SymbolString(46) = "100110010"

X = X / 0.376042 'mm to pt
Y = Y / 0.341 'mm to pt
Height = Height / 0.341 'mm to pt
Content = UCase(Content)

'C checksum counting
C_WeightIndex = Len(Content) Mod 20
[COLOR=#ff0000]If C_WeightIndex = 0 Then C_WeightIndex = 20[/COLOR]
For i = 1 To Len(Content)
    j = -1
    Do 
        If j > 46 Then Exit Sub
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    'C_WeightSum = C_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i) ' 20
    C_WeightSum = C_WeightSum + SymbolValue(j) * C_WeightIndex
    C_WeightIndex = C_WeightIndex - 1
    If C_WeightIndex = 0 Then C_WeightIndex = 20
Next i
C_CheckSum = C_WeightSum Mod 47

Content = Content + SymbolChar(C_CheckSum)

'K checksum counting
K_WeightIndex = Len(Content) Mod 15
[COLOR=#ff0000]If K_WeightIndex = 0 Then C_WeightIndex = 15[/COLOR]

For i = 1 To Len(Content)
    j = -1
    Do 
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    'K_WeightSum = K_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i) ' 15
    K_WeightSum = K_WeightSum + SymbolValue(j) * K_WeightIndex ' 15
    K_WeightIndex = K_WeightIndex - 1
    If K_WeightIndex = 0 Then K_WeightIndex = 15
Next i

K_CheckSum = K_WeightSum Mod 47

Content = Content + SymbolChar(K_CheckSum)
ContentString = SSSymbol

For i = 1 To Len(Content)
   j = -1
    Do 
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    ContentString = ContentString + SymbolString(j)
Next i
ContentString = ContentString + SSSymbol + Tbar_Symbol

'Barcode drawing
CurBar = 0

For i = 1 To Len(ContentString)
    Select Case Mid(ContentString, i, 1)
    Case 0
        CurBar = CurBar + 1
    Case 1
        CurBar = CurBar + 1
        With TargetSheet.Shapes.AddLine(X + (CurBar * LineWeight) * 0.9, Y, X + (CurBar * LineWeight) * 0.9, (Y + Height)).Line
        .Weight = LineWeight
        .ForeColor.RGB = vbBlack
        End With
    End Select
Next i

End Sub

The code was tested for the values it was not able to encode before and showed positive results.

Finally, very sorry for any troubles which could occur in your implementations. Now it should be OK.

I expect to stop further code development as Code93 is quite old-fashioned. I would rather switch to Code128 enhancement.
As before comments and questions are welcome.

Yakovleff
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
QRCode Generator
Replies
1
Views
1K
drag1c
D
M
  • Solved
My code was working 2 days back but now my excel just crashes. Thank for any help in Advance!
Replies
9
Views
278
Alex Blakenburg
A
Weeble
  • Question
VBA change position of a created barcode object
Replies
2
Views
1K
Weeble
Weeble
Y
  • Question
"Code128" barcode generator in VBA
5 6 7
Replies
68
Views
88K
polob12
P
Tetra201
  • Question
Excel VBA Barcode Generator
2
Replies
16
Views
12K
kelly mort
kelly mort

Forum statistics

Threads
1,215,563
Messages
6,125,568
Members
449,237
Latest member
Chase S

Share this page

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