"Code128" barcode generator in VBA

[yakovleff]

Hello All,

Since the Code93 barcode generator has been developed I've been thinking of Code128. And finally I've developed it! As before want to share it with other Mr.Excel users and Google searchers.
It was much easier and faster than Code93 as Code128 is simpler to encode and yet more powerful particularly for strings of digits.

Main features:
- Main symbology has been picked from CODE128 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;
- Code uses "B" and "C" charsets only;
- A "tweak" for numeric strings has been implemented: If a numeric string to be encoded is of odd length the first symbol is encoded as "B"; the rest of symbols are encoded as "C". This tweak significantly reduces barcode length for a numeric string.
- 10% bars overlapping is used for drawing as this value showed the best result at scanning tests.

Weaknesses/incompletenesses:
- Code does not generate any special "instruction" symbols: symbols 95-98, 100, 102 in charset "B" and 102 in charset "C".
- Code does not check the length of the encoded string;
- 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
- 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 to develop and tests.
So, the main code is:

<code>
Sub Code128Generate(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, _
                  ByRef TargetSheet As Worksheet, ByVal Content As String)
' Supports B and C charsets only; values 00-94, 99,101, 103-105 for B, 00-101, 103-105 for C
' X, Y - top-left corner coordinates
' X in mm (0.376042)
' Y in mm (0.341)
' Height in mm
' LineWeight in pt

Const Tbar_Symbol As String * 2 = "11" ' termination bar
Dim WeightSum As Single
Dim CurBar As Integer
Dim i, j, k, FirstSymbol As Integer
Dim tstr2 As String * 2
Dim tstr1 As String * 1
Dim ContentString As String ' bars sequence

Dim SymbolValue(0 To 106) As Integer ' values
Dim SymbolString(0 To 106) As String * 11 'bits sequence
Dim SymbolCharB(0 To 106) As String * 1  'Chars in B set
Dim SymbolCharC(0 To 106) As String * 2  'Chars in B set

For i = 0 To 106 ' values
    SymbolValue(i) = i
Next i

' Symbols in charset B
For i = 0 To 94
    SymbolCharB(i) = Chr(i + 32)
Next i

' Symbols in charset C
SymbolCharC(0) = "00"
SymbolCharC(1) = "01"
SymbolCharC(2) = "02"
SymbolCharC(3) = "03"
SymbolCharC(4) = "04"
SymbolCharC(5) = "05"
SymbolCharC(6) = "06"
SymbolCharC(7) = "07"
SymbolCharC(8) = "08"
SymbolCharC(9) = "09"
For i = 10 To 99
    SymbolCharC(i) = CStr(i)
Next i

' bit sequences
SymbolString(0) = "11011001100"
SymbolString(1) = "11001101100"
SymbolString(2) = "11001100110"
SymbolString(3) = "10010011000"
SymbolString(4) = "10010001100"
SymbolString(5) = "10001001100"
SymbolString(6) = "10011001000"
SymbolString(7) = "10011000100"
SymbolString(8) = "10001100100"
SymbolString(9) = "11001001000"
SymbolString(10) = "11001000100"
SymbolString(11) = "11000100100"
SymbolString(12) = "10110011100"
SymbolString(13) = "10011011100"
SymbolString(14) = "10011001110"
SymbolString(15) = "10111001100"
SymbolString(16) = "10011101100"
SymbolString(17) = "10011100110"
SymbolString(18) = "11001110010"
SymbolString(19) = "11001011100"
SymbolString(20) = "11001001110"
SymbolString(21) = "11011100100"
SymbolString(22) = "11001110100"
SymbolString(23) = "11101101110"
SymbolString(24) = "11101001100"
SymbolString(25) = "11100101100"
SymbolString(26) = "11100100110"
SymbolString(27) = "11101100100"
SymbolString(28) = "11100110100"
SymbolString(29) = "11100110010"
SymbolString(30) = "11011011000"
SymbolString(31) = "11011000110"
SymbolString(32) = "11000110110"
SymbolString(33) = "10100011000"
SymbolString(34) = "10001011000"
SymbolString(35) = "10001000110"
SymbolString(36) = "10110001000"
SymbolString(37) = "10001101000"
SymbolString(38) = "10001100010"
SymbolString(39) = "11010001000"
SymbolString(40) = "11000101000"
SymbolString(41) = "11000100010"
SymbolString(42) = "10110111000"
SymbolString(43) = "10110001110"
SymbolString(44) = "10001101110"
SymbolString(45) = "10111011000"
SymbolString(46) = "10111000110"
SymbolString(47) = "10001110110"
SymbolString(48) = "11101110110"
SymbolString(49) = "11010001110"
SymbolString(50) = "11000101110"
SymbolString(51) = "11011101000"
SymbolString(52) = "11011100010"
SymbolString(53) = "11011101110"
SymbolString(54) = "11101011000"
SymbolString(55) = "11101000110"
SymbolString(56) = "11100010110"
SymbolString(57) = "11101101000"
SymbolString(58) = "11101100010"
SymbolString(59) = "11100011010"
SymbolString(60) = "11101111010"
SymbolString(61) = "11001000010"
SymbolString(62) = "11110001010"
SymbolString(63) = "10100110000"
SymbolString(64) = "10100001100"
SymbolString(65) = "10010110000"
SymbolString(66) = "10010000110"
SymbolString(67) = "10000101100"
SymbolString(68) = "10000100110"
SymbolString(69) = "10110010000"
SymbolString(70) = "10110000100"
SymbolString(71) = "10011010000"
SymbolString(72) = "10011000010"
SymbolString(73) = "10000110100"
SymbolString(74) = "10000110010"
SymbolString(75) = "11000010010"
SymbolString(76) = "11001010000"
SymbolString(77) = "11110111010"
SymbolString(78) = "11000010100"
SymbolString(79) = "10001111010"
SymbolString(80) = "10100111100"
SymbolString(81) = "10010111100"
SymbolString(82) = "10010011110"
SymbolString(83) = "10111100100"
SymbolString(84) = "10011110100"
SymbolString(85) = "10011110010"
SymbolString(86) = "11110100100"
SymbolString(87) = "11110010100"
SymbolString(88) = "11110010010"
SymbolString(89) = "11011011110"
SymbolString(90) = "11011110110"
SymbolString(91) = "11110110110"
SymbolString(92) = "10101111000"
SymbolString(93) = "10100011110"
SymbolString(94) = "10001011110"
SymbolString(95) = "10111101000"
SymbolString(96) = "10111100010"
SymbolString(97) = "11110101000"
SymbolString(98) = "11110100010"
SymbolString(99) = "10111011110"
SymbolString(100) = "10111101110"
SymbolString(101) = "11101011110"
SymbolString(102) = "11110101110"
SymbolString(103) = "11010000100"
SymbolString(104) = "11010010000"
SymbolString(105) = "11010011100"
SymbolString(106) = "11000111010"

X = X / 0.376042 'mm to pt
Y = Y / 0.341 'mm to pt
Height = Height / 0.341 'mm to pt

If IsNumeric(Content) = True Then  ' value is numeric
   i = 1 'symbol and weight index
   If Len(Content) Mod 2 = 1 Then 'odd
       WeightSum = SymbolValue(104) ' start-b
       ContentString = ContentString + SymbolString(104)
      tstr1 = Mid(Content, 1, 1)
      k = 0
      Do While tstr1 <> SymbolCharB(k)
         k = k + 1
      Loop
      WeightSum = WeightSum + i * SymbolValue(k)
      ContentString = ContentString + SymbolString(k)
      i = i + 1
      WeightSum = WeightSum + i * SymbolValue(99) 'Code-C
      ContentString = ContentString + SymbolString(99) 'Code-C
      Content = Right(Content, Len(Content) - 1) 'cut 1st symbol
   Else 'even
      WeightSum = SymbolValue(105) ' start-c
      ContentString = ContentString + SymbolString(105)
      i = 0
   End If
   
   For j = 1 To Len(Content) Step 2
      tstr2 = Mid(Content, j, 2)
      i = i + 1
      k = 0
      Do While tstr2 <> SymbolCharC(k)
         k = k + 1
      Loop
      WeightSum = WeightSum + i * SymbolValue(k)
      ContentString = ContentString + SymbolString(k)
   Next j
   ContentString = ContentString + SymbolString(SymbolValue(WeightSum Mod 103))
   ContentString = ContentString + SymbolString(106)

   
   Else ' alpha-numeric
   WeightSum = SymbolValue(104) ' start-b
   ContentString = ContentString + SymbolString(104)
   i = 0 ' symbol count
   For j = 1 To Len(Content) Step 1
      tstr1 = Mid(Content, j, 1)
      i = i + 1
      k = 0
      Do While tstr1 <> SymbolCharB(k)
         k = k + 1
      Loop
      WeightSum = WeightSum + i * SymbolValue(k)
      ContentString = ContentString + SymbolString(k)
   Next j
   ContentString = ContentString + SymbolString(SymbolValue(WeightSum Mod 103))
   ContentString = ContentString + SymbolString(106)

End If

ContentString = ContentString + 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
' (CurBar * LineWeight) * [B]0.9[/B] -  here is 10% overlapping :-)
        With TargetSheet.Shapes.AddLine(X + (CurBar * LineWeight) * 0.9, Y, X + (CurBar * LineWeight) * 0.9, (Y + Height)).Line
        .Weight = LineWeight
        .ForeColor.RGB = vbBlack ' my Excel writes light-blue lines by default, so the color is forcibly switched
        End With
    End Select
Next i

End Sub
</code>

Barcode reading has been tested by an Android phone (Accusoft Barcode Scanner program) as well as by a PROTON IMS-3100 and a cheap Chineese (PAN.CODE A500) hardware scanners.

Hope it would be of any help to anybody.
Would be helpful for me if you comment this thread when using it in your apps.

Regards,
Yakovleff

 

[yakovleff]

Re: "Code128" barcode generator in VBA - version 2

One thing I need will be to be able to place the code at a given location than its current location-i don't know which line will do that.

Dear colleague, I think you mean current active cell on the active sheet. Yes, I was also trying to match the position to cells but it occured useless as my main use of it was printing. Printing position does not strictly correlate to cell position or size. I came to fine tuning through printing tests.

Also, if I can reduce the size of the bars, I will love it.

Please read thoroughly the procedure declaration
Sub Code128Generate_v2(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, _ ByRef TargetSheet As Worksheet, ByVal Content As String, Optional MaxWidth As Single = 0)
and test call
Code128Generate_v2 5, 5, 15, 1.5, ThisWorkbook.ActiveSheet, "11Q94PTT"
There are X, Y, Height, LineWeight, MaxWidth vars which define horizontal, vertical positions, weight of lines and spaces and maximum width of the code respectively. I expected them quite clearly explained

Then, will it be possible to place the code on a label? - maybe form control or ActiveX control on a given sheet..

I'll Try to think of it

Then, instead of selecting all shapes, I will like to select just the bar codes. Because, there might be other shapes that I might not want to delete.

Oh, yes, life is running and Excel is changing (2010 is my version yet). Each user may require his/her own specific features. That Sub test() was a debug feature only in order not to overlap barcodes.
I'll try to do something with it.

 

[Lucullus]

Dear colleague, I have an idea which is the value you want to encode is too long for variables declarations. I'll try to run your example and try to debug where the problem is.

The problem is "C5" which isn´t a value between 0 and 106. Thank you for taking your time.

 

[kelly mort]

Dear colleague, I think you mean current active cell on the active sheet. Yes, I was also trying to match the position to cells but it occured useless as my main use of it was printing. Printing position does not strictly correlate to cell position or size. I came to fine tuning through printing tests.


Please read thoroughly the procedure declaration
Sub Code128Generate_v2(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, _ ByRef TargetSheet As Worksheet, ByVal Content As String, Optional MaxWidth As Single = 0)
and test call
Code128Generate_v2 5, 5, 15, 1.5, ThisWorkbook.ActiveSheet, "11Q94PTT"
There are X, Y, Height, LineWeight, MaxWidth vars which define horizontal, vertical positions, weight of lines and spaces and maximum width of the code respectively. I expected them quite clearly explained


I'll Try to think of it


Oh, yes, life is running and Excel is changing (2010 is my version yet). Each user may require his/her own specific features. That Sub test() was a debug feature only in order not to overlap barcodes.
I'll try to do something with it.

Okay thanks.

I am running on 2016 professional. So what will be the code for the last part of your reply in this post I am replying to?

 

[yakovleff]

The problem is "C5" which isn´t a value between 0 and 106. Thank you for taking your time.

Dear user, I have run your example 67650C55974117DA265FCAB10C492F76 at Excel 2010 and the barcode has been successfully generated without any modification of the code. Please try to use latest version here.

 

[yakovleff]

I am running on 2016 professional. So what will be the code for the last part of your reply in this post I am replying to?

The most obvious way of removing the lines is

   For Each sh In ThisWorkbook.ActiveSheet.Shapes
      If sh.Type = 9 Then sh.Delete
   Next

It will affect all the lines which are on the sheet. User joelloewen has offered smarter solution Oct 31, 2018 by naming each barcode line with specific name and then removing them only.

 

[yakovleff]

Then, will it be possible to place the code on a label? - maybe form control or ActiveX control on a given sheet..

For the moment it seems to be beyond my knowledges in VBA. However I have found an idea to develop.

 

[yakovleff]

The problem is "C5" which isn´t a value between 0 and 106. Thank you for taking your time.

Proof is here.

 

[Lucullus]

Proof is here.

Hello Yakovleff,

now I´m speechless. Here at home it works. I will try again tomorrow in office. But I was sure I had your newest code (v2)!
Thank you for your help. I will tell you if it will also work in office.

 

[Lucullus]

Proof is here.

It works.
The reason was a missing line you must have added since your post from June 7, 2017: CharIndex = CharIndex + 1

Thank you very much.

 

[Lucullus]

I know I should have read the whole thread...