"Code128" barcode generator in VBA

yakovleff · Jun 12, 2014

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

eiram · Feb 29, 2016

Hello,

sorry to bring this old post back up but this should be exactly what I need.
Thank you Mr Yakovleff for your work!

I want to create Code128 in Excel without any 3rd party tools/fonts.

Could someone please give me an example on how to use this piece of code?
All I achieve is a **** "Syntax error".
=Code128Generate(0;0;10;10;Sheet1;"test")

Thank you for your help
eiram

yakovleff · Feb 29, 2016

eiram said:
Hello,

Could someone please give me an example on how to use this piece of code?
eiram

Hi, Eiram,

Seems to be my fault, sorry. I did not describe variables the Sub uses.

So, just put the sub into your project and call the sub from your main code with the following parameters:

<code>ByVal X As Single - horizontal coordinate in mm from the left edge of a sheet
ByVal Y As Single <code>- vertical coordinate in mm from the top edge of a sheet</code>
ByVal Height As Single - height of a barcode in mm (barcode will be drawn down from the Y)
ByVal LineWeight As Single - thickness of a barcode line representing "1" (black line) in pt
ByRef TargetSheet As Worksheet - a target worksheet where a barcode will be drawn
ByVal Content As String - string of what to be encoded</code>

An example:
Call <code>Code128Generate(5, 5, 10, 0.5, Thisworkbook.Sheets(1), "123456")</code>

Try again and everything should work at least on Excel 2007.

In your example I can see a mistake of Code128Generate(0;0;10;10;Sheet1;"test") as Excel can not address a sheet by that reference.
Good luck!

yakovleff · Mar 1, 2016

Some samples of how it works for logistics applications.
A4:

8x labels at A4 sheet:

16x labels at A4 sheet:

eiram · Mar 1, 2016

Thank you!

Gave it another try today at work and it works just perfect!
Awesome work, I can't thank you enough.

thiagotw · Apr 7, 2016

Hi,
I'm new on VBA, i have tried to find some code or software that works for me but no lucky... by judge your images above, your code looks great! but i can´t make it work at least on excel 2013 plz help!

Here is what i have to turn in bar codes.

Here is what i need, (i did this with 3rd part tool, but its expires and don't let me edit)

My .xls file Semana 12 (14-03 á 18-03)

yakovleff · Jun 7, 2017

Dear thiagotw,
Sorry not to answer your question in time. Is it still alive question?

yakovleff · Jun 7, 2017

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

yakovleff · Jun 7, 2017

thiagotw,
Really sorry not answering your question in time.
Sometimes I have the same challenge and I act as follows:
- either split cells for a barcode and for the value
- extend the cell in hight and apply "bottom alignment" for text for this cell.
Hope this would help you.

Tetra201 · Jun 7, 2017

@yakovleff:

Just an FYI.

"Code128" barcode generator in VBA

yakovleff

New Member

Excel Facts

eiram

New Member

yakovleff

New Member

yakovleff

New Member

eiram

New Member

thiagotw

New Member

yakovleff

New Member

yakovleff

New Member

yakovleff

New Member

Tetra201

MrExcel MVP

Similar threads

Forum statistics

Share this page

"Code128" barcode generator in VBA

New Member

Excel Facts

New Member

New Member

New Member

New Member

New Member

New Member

New Member

New Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock