"Code128" barcode generator in VBA

yakovleff

New Member
Joined
May 20, 2013
Messages
41
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
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:
<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
 
Re: "Code128" barcode generator in VBA - version 2

Thanks and nice to hear the code is useful for someone :)
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Re: "Code128" barcode generator in VBA - version 2

Thanks and nice to hear the code is useful for someone :)

Hi friend, thanks very much for Code128 work. it is very nice. I want to use it in Access vba. How can I use it. I want to write barcode in report.

Thanks very much.

Levent
 
Upvote 0
Re: "Code128" barcode generator in VBA - version 2

Hi friend, thanks very much for Code128 work. it is very nice. I want to use it in Access vba. How can I use it. I want to write barcode in report.
Levent

Dear Levent, unfortunately I am not familiar to Access programming object model so can't help here. Hope it is quite similar to Excel. Good luck!
 
Upvote 0
Re: "Code128" barcode generator in VBA - version 2

Hi,
3 years after the first version has been developed I have (significantly) updated it with the following features:
1. Enchanced Code B encoding algorithm is embedded: The code splits the string to be encoded into Alpha (A) and Digital (D) blocks. Each block consists of either digits 0-9 (D-block) or other chars (A-block). The string "1A2B3C4D" would be considered as "D1A1D1A1D1A1D1A1"; The string "12345ABCDE" would look as "D5A5". If the D-block's length is 4 or more digits it switches encoding into Mode C. The odd remainder (5 in 12345 string) is then encoded back in B mode.
NB. The total amount of blocks is limited with ArrDim const = 30. If you need more just set that const to preferred value.
This measure significantly reduces barcode length and increases capacity when a string contains many continious digits.
2. Maximum width of a barcode can be set now. Optional MaxWidth (in mm) argument has been added. The code will check and reduce bar width in order to place whole the barcode into the width limit. This may cause extremely narrow bar widths and lacks of reading.
If MaxWidth is omitted LineWeight would be used unchanged.
3. The mm to pt ratio has been changed to 0.351 (1 mm = 2.8 pt) as it is pre-defined in Excel. It seems it shows better results in 100% scale printing. To restore your settings just set constants XmmTopt, YmmTopt to preferred values.
4. The constant XCompRatio is now responsible for "overlapping" of the bar strokes.

I post the code here "as is". Use it freely responsibly. No responsibility for commercial use would be commited.



Code:
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)
' Supports B and C charsets only; values 00-94, 99,101, 103-105 for B, 00-101, 103-105 for C
' X in mm (0.351)
' Y in mm (0.351) 1mm = 2.8 pt
' Height in mm
' LineWeight in pt






Dim WeightSum As Single
Const XmmTopt As Single = 0.351
Const YmmTopt As Single = 0.351
Const XCompRatio As Single = 0.9


Const Tbar_Symbol As String * 2 = "11"
Dim CurBar As Integer
Dim i, j, k, CharIndex, SymbolIndex As Integer
Dim tstr2 As String * 2
Dim tstr1 As String * 1
Dim ContentString As String ' bars sequence
Const Asw As String * 1 = "A" ' alpha switch
Const Dsw As String * 1 = "D" 'digital switch
Const Arrdim As Byte = 30


Dim Sw, PrevSw As String * 1  ' switch
Dim BlockIndex, BlockCount, DBlockMod2, DBlockLen As Byte


Dim BlockLen(Arrdim) As Byte
Dim BlockSw(Arrdim) As String * 1


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 / XmmTopt 'mm to pt
Y = Y / YmmTopt 'mm to pt
Height = Height / YmmTopt 'mm to pt


If IsNumeric(Content) = True And Len(Content) Mod 2 = 0 Then 'numeric, mode C
   WeightSum = SymbolValue(105) ' start-c
   ContentString = ContentString + SymbolString(105)
   i = 0 ' symbol count
   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)
   ContentString = ContentString + Tbar_Symbol
   
Else ' alpha-numeric
   
   ' first digit
   Select Case IsNumeric(Mid(Content, 1, 1))
   Case Is = True 'digit
      Sw = Dsw
   Case Is = False 'alpha
      Sw = Asw
   End Select
   BlockCount = 1
   BlockSw(BlockCount) = Sw
   BlockIndex = 1
   BlockLen(BlockCount) = 1 'block length


   
   i = 2 ' symbol index
   
   Do While i <= Len(Content)
      Select Case IsNumeric(Mid(Content, i, 1))
      Case Is = True 'digit
         Sw = Dsw
      Case Is = False 'alpha
         Sw = Asw
      End Select
      
      If Sw = BlockSw(BlockCount) Then
         BlockLen(BlockCount) = BlockLen(BlockCount) + 1
      Else
         BlockCount = BlockCount + 1
         BlockSw(BlockCount) = Sw
         BlockLen(BlockCount) = 1
         BlockIndex = BlockIndex + 1


      End If
      
      i = i + 1
   Loop
   


   'encoding
   CharIndex = 1 'index of Content character
   SymbolIndex = 0
   
   For BlockIndex = 1 To BlockCount ' encoding by blocks


      If BlockSw(BlockIndex) = Dsw And BlockLen(BlockIndex) >= 4 Then ' switch to C
         Select Case BlockIndex
         Case Is = 1
            WeightSum = SymbolValue(105) ' Start-C
            ContentString = ContentString + SymbolString(105)
         Case Else
            SymbolIndex = SymbolIndex + 1
            WeightSum = WeightSum + SymbolIndex * SymbolValue(99) 'switch c
            ContentString = ContentString + SymbolString(99)
         End Select
         PrevSw = Dsw
         
         ' encoding even amount of chars in a D block
         DBlockMod2 = BlockLen(BlockIndex) Mod 2
         If DBlockMod2 <> 0 Then 'even chars always to encode
            DBlockLen = BlockLen(BlockIndex) - DBlockMod2
         Else
            DBlockLen = BlockLen(BlockIndex)
         End If
         
         For j = 1 To DBlockLen / 2 Step 1
            tstr2 = Mid(Content, CharIndex, 2)
            CharIndex = CharIndex + 2
            SymbolIndex = SymbolIndex + 1
            k = 0
            Do While tstr2 <> SymbolCharC(k)
               k = k + 1
            Loop
            WeightSum = WeightSum + SymbolIndex * SymbolValue(k)
            ContentString = ContentString + SymbolString(k)
         Next j
         
         If DBlockMod2 <> 0 Then ' switch to B, encode 1 char
            PrevSw = Asw
            SymbolIndex = SymbolIndex + 1
            WeightSum = WeightSum + SymbolIndex * SymbolValue(100) 'switch b
            ContentString = ContentString + SymbolString(100)
            
            'CharIndex = CharIndex + 1
            SymbolIndex = SymbolIndex + 1
            tstr1 = Mid(Content, CharIndex, 1)
            k = 0
            Do While tstr1 <> SymbolCharB(k)
               k = k + 1
            Loop
            WeightSum = WeightSum + SymbolIndex * SymbolValue(k)
            ContentString = ContentString + SymbolString(k)
         End If
         
      
      Else 'alpha in B mode
         Select Case BlockIndex
         Case Is = 1
         '   PrevSw = Asw
            WeightSum = SymbolValue(104) ' start-b
            ContentString = ContentString + SymbolString(104)
         Case Else
            If PrevSw <> Asw Then
               SymbolIndex = SymbolIndex + 1
               WeightSum = WeightSum + SymbolIndex * SymbolValue(100) 'switch b
               ContentString = ContentString + SymbolString(100)
               
            End If
         End Select
         PrevSw = Asw
         
         For j = CharIndex To CharIndex + BlockLen(BlockIndex) - 1 Step 1
            tstr1 = Mid(Content, j, 1)
            SymbolIndex = SymbolIndex + 1
            k = 0
            Do While tstr1 <> SymbolCharB(k)
               k = k + 1
            Loop
            WeightSum = WeightSum + SymbolIndex * SymbolValue(k)
            ContentString = ContentString + SymbolString(k)
         Next j
         CharIndex = j


      End If
   Next BlockIndex
   ContentString = ContentString + SymbolString(SymbolValue(WeightSum Mod 103))
   ContentString = ContentString + SymbolString(106)
   ContentString = ContentString + Tbar_Symbol
   
End If


   If MaxWidth > 0 And Len(ContentString) * LineWeight * XmmTopt > MaxWidth Then
      LineWeight = MaxWidth / (Len(ContentString) * XmmTopt)
      LineWeight = LineWeight / XCompRatio
   End If
   
'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) * XCompRatio, Y, X + (CurBar * LineWeight) * XCompRatio, (Y + Height)).Line
        .Weight = LineWeight
        .ForeColor.RGB = vbBlack
        End With
    End Select
Next i




End Sub


Hi! How are you doing?
I am new to VBA Please can you help me step by step how to use this code in Excel, I am trying to do it but I get errors.

Thanks,
 
Upvote 0
Re: "Code128" barcode generator in VBA - version 2

Code:
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)
' Supports B and C charsets only; values 00-94, 99,101, 103-105 for B, 00-101, 103-105 for C
' X in mm (0.351)
' Y in mm (0.351) 1mm = 2.8 pt
' Height in mm
' LineWeight in pt






Dim WeightSum As Single
Const XmmTopt As Single = 0.351
Const YmmTopt As Single = 0.351
Const XCompRatio As Single = 0.9


Const Tbar_Symbol As String * 2 = "11"
Dim CurBar As Integer
Dim i, j, k, CharIndex, SymbolIndex As Integer
Dim tstr2 As String * 2
Dim tstr1 As String * 1
Dim ContentString As String ' bars sequence
Const Asw As String * 1 = "A" ' alpha switch
Const Dsw As String * 1 = "D" 'digital switch
Const Arrdim As Byte = 30


Dim Sw, PrevSw As String * 1  ' switch
Dim BlockIndex, BlockCount, DBlockMod2, DBlockLen As Byte


Dim BlockLen(Arrdim) As Byte
Dim BlockSw(Arrdim) As String * 1


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 / XmmTopt 'mm to pt
Y = Y / YmmTopt 'mm to pt
Height = Height / YmmTopt 'mm to pt


If IsNumeric(Content) = True And Len(Content) Mod 2 = 0 Then 'numeric, mode C
   WeightSum = SymbolValue(105) ' start-c
   ContentString = ContentString + SymbolString(105)
   i = 0 ' symbol count
   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)
   ContentString = ContentString + Tbar_Symbol
   
Else ' alpha-numeric
   
   ' first digit
   Select Case IsNumeric(Mid(Content, 1, 1))
   Case Is = True 'digit
      Sw = Dsw
   Case Is = False 'alpha
      Sw = Asw
   End Select
   BlockCount = 1
   BlockSw(BlockCount) = Sw
   BlockIndex = 1
   BlockLen(BlockCount) = 1 'block length


   
   i = 2 ' symbol index
   
   Do While i <= Len(Content)
      Select Case IsNumeric(Mid(Content, i, 1))
      Case Is = True 'digit
         Sw = Dsw
      Case Is = False 'alpha
         Sw = Asw
      End Select
      
      If Sw = BlockSw(BlockCount) Then
         BlockLen(BlockCount) = BlockLen(BlockCount) + 1
      Else
         BlockCount = BlockCount + 1
         BlockSw(BlockCount) = Sw
         BlockLen(BlockCount) = 1
         BlockIndex = BlockIndex + 1


      End If
      
      i = i + 1
   Loop
   


   'encoding
   CharIndex = 1 'index of Content character
   SymbolIndex = 0
   
   For BlockIndex = 1 To BlockCount ' encoding by blocks


      If BlockSw(BlockIndex) = Dsw And BlockLen(BlockIndex) >= 4 Then ' switch to C
         Select Case BlockIndex
         Case Is = 1
            WeightSum = SymbolValue(105) ' Start-C
            ContentString = ContentString + SymbolString(105)
         Case Else
            SymbolIndex = SymbolIndex + 1
            WeightSum = WeightSum + SymbolIndex * SymbolValue(99) 'switch c
            ContentString = ContentString + SymbolString(99)
         End Select
         PrevSw = Dsw
         
         ' encoding even amount of chars in a D block
         DBlockMod2 = BlockLen(BlockIndex) Mod 2
         If DBlockMod2 <> 0 Then 'even chars always to encode
            DBlockLen = BlockLen(BlockIndex) - DBlockMod2
         Else
            DBlockLen = BlockLen(BlockIndex)
         End If
         
         For j = 1 To DBlockLen / 2 Step 1
            tstr2 = Mid(Content, CharIndex, 2)
            CharIndex = CharIndex + 2
            SymbolIndex = SymbolIndex + 1
            k = 0
            Do While tstr2 <> SymbolCharC(k)
               k = k + 1
            Loop
            WeightSum = WeightSum + SymbolIndex * SymbolValue(k)
            ContentString = ContentString + SymbolString(k)
         Next j
         
         If DBlockMod2 <> 0 Then ' switch to B, encode 1 char
            PrevSw = Asw
            SymbolIndex = SymbolIndex + 1
            WeightSum = WeightSum + SymbolIndex * SymbolValue(100) 'switch b
            ContentString = ContentString + SymbolString(100)
            
            'CharIndex = CharIndex + 1
            SymbolIndex = SymbolIndex + 1
            tstr1 = Mid(Content, CharIndex, 1)
            k = 0
            Do While tstr1 <> SymbolCharB(k)
               k = k + 1
            Loop
            WeightSum = WeightSum + SymbolIndex * SymbolValue(k)
            ContentString = ContentString + SymbolString(k)
         End If
         
      
      Else 'alpha in B mode
         Select Case BlockIndex
         Case Is = 1
         '   PrevSw = Asw
            WeightSum = SymbolValue(104) ' start-b
            ContentString = ContentString + SymbolString(104)
         Case Else
            If PrevSw <> Asw Then
               SymbolIndex = SymbolIndex + 1
               WeightSum = WeightSum + SymbolIndex * SymbolValue(100) 'switch b
               ContentString = ContentString + SymbolString(100)
               
            End If
         End Select
         PrevSw = Asw
         
         For j = CharIndex To CharIndex + BlockLen(BlockIndex) - 1 Step 1
            tstr1 = Mid(Content, j, 1)
            SymbolIndex = SymbolIndex + 1
            k = 0
            Do While tstr1 <> SymbolCharB(k)
               k = k + 1
            Loop
            WeightSum = WeightSum + SymbolIndex * SymbolValue(k)
            ContentString = ContentString + SymbolString(k)
         Next j
         CharIndex = j


      End If
   Next BlockIndex
   ContentString = ContentString + SymbolString(SymbolValue(WeightSum Mod 103))
   ContentString = ContentString + SymbolString(106)
   ContentString = ContentString + Tbar_Symbol
   
End If


   If MaxWidth > 0 And Len(ContentString) * LineWeight * XmmTopt > MaxWidth Then
      LineWeight = MaxWidth / (Len(ContentString) * XmmTopt)
      LineWeight = LineWeight / XCompRatio
   End If
   
'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) * XCompRatio, Y, X + (CurBar * LineWeight) * XCompRatio, (Y + Height)).Line
        .Weight = LineWeight
        .ForeColor.RGB = vbBlack
        End With
    End Select
Next i




End Sub
[/QUOTE]


Hi! How are you doing?
I am new to VBA Please can someone help me step by step how to use this code in Excel, I am trying to do it but I get errors.

Thanks,
 
Upvote 0
Re: "Code128" barcode generator in VBA - version 2

Hi! How are you doing?
I am new to VBA Please can someone help me step by step how to use this code in Excel, I am trying to do it but I get errors.

Thanks,
Hi,

Please look earlier posts in this thread for "latest sample" and talks around it. You can download it, open in Excel and VBA PE (Alt+F11) and test it.
Good luck!
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,034
Members
448,543
Latest member
MartinLarkin

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