"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. :smile:
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. :smile:
Would be helpful for me if you comment this thread when using it in your apps.

Regards,
Yakovleff
 
Nice to give an inspiration for a good piece of code. Let's make our VBA world better together :)
 
Upvote 0

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
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,

Hi I'm new on Excel and VBA, can you attach a excel file with the code for me to try, I try to copy the code into Excel2007 but I don't know how to call it in the workbook. I try =Code128Generate_v2(5, 5, 10, 0.5, Thisworkbook.Sheets(1), "123456") in any address but the cell return a #VALUE ! error, thank you.
 
Last edited:
Upvote 0
Re: "Code128" barcode generator in VBA - version 2

yakovleff,

Hi I'm new on Excel and VBA, can you attach a excel file with the code for me to try, I try to copy the code into Excel2007 but I don't know how to call it in the workbook. I try =Code128Generate_v2(5, 5, 10, 0.5, Thisworkbook.Sheets(1), "123456") in any address but the cell return a #VALUE ! error, thank you.

Hello,

This sub can not be used in a cell.
(To get known about teh VBA you can start with https://www.youtube.com/watch?v=IIuKCxPlaTY)

Open a new book.
Press Alt+F11 to open the VBA IDE.
Double-click "ThisWorkbook" (or Thisbook) branch of the VBAProject
Copy and paste all the code of the sub Sub Code128Generate_v2 including End Sub.
Then add another sub below:
Code:
Sub test()
   ThisWorkbook.ActiveSheet.Shapes.SelectAll
   Selection.Delete
   Code128Generate_v2 0, 5, 15, 1.5, ThisWorkbook.ActiveSheet, "0123456789ABCDEFGH", 90


End Sub
Modify the params <0, 5, 15, 1.5, ThisWorkbook.ActiveSheet, "0123456789ABCDEFGH", 90> of the sub call with required ones by your task.

Welcome to VBA world!
 
Upvote 0
Re: "Code128" barcode generator in VBA - version 2

Hello,

Modify the params <0, 5, 15, 1.5, ThisWorkbook.ActiveSheet, "0123456789ABCDEFGH", 90> of the sub call with required ones by your task.
Sorry, put the cursor into the text of test() sub.
Push F5 (Run).
Look to your new workbook active sheet. The barcode must be seen at the top left.
 
Upvote 0
Re: "Code128" barcode generator in VBA - version 2

Hi yakovleff,

No idea what's wrong but after your steps, when I'm trying to run the macro, it shows
Code:
Compile error: 

Sub or Function not defined
I'd paste the whole Code128Generator_v2 code to the ThisWorkbook profile, and then I've created a macro from your previous post.
No clue what I'm doing wrong...

As well, (if you will be able to help me when the generator will work), can I use a cell as a source of the text from which the barcode will be generated?
 
Upvote 0
Re: "Code128" barcode generator in VBA - version 2

Hi yakovleff,

No clue what I'm doing wrong...

As well, (if you will be able to help me when the generator will work), can I use a cell as a source of the text from which the barcode will be generated?

Hello,

Try the sample. It works in my Excel 2007 on Win 7.

And yes, you can use a cell value as a source. I use
Code:
Activesheet.Cells(RowIndex<row index="">,ColIndex).Value
technique. RowIndex<row index="">,ColIndex should appear as digits.
</row>However it's better to get a bit more familiar to VBA to feel yourself comfortable.</row>
 
Upvote 0
Hi yakovleff,

Thank you for your sample, it works perfectly.
I found out why it doesn't work for me - I was adding the code into the "ThisWorkbook" profile. You've actually added that as Module, so I did this same and it works!

I've just started with VBA, this is part of my code:
Code:
            Dim trim As Range
            For Each trim In Worksheets("Template").Range("C2:M3")
            trim = WorksheetFunction.trim(trim)
        Next
            Dim shp As Shape
            Dim r As Range
            Set r = Worksheets("Template").Range("AB1:AI1")
            For Each shp In Worksheets("Template").Shapes
            If Not Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), r) Is Nothing Then _
            shp.Delete
        Next
            Code128Generate_v2 154, 0, 8, 0.8, Worksheets("Template"), Worksheets("Template").Cells(2, 3).Value, 90

Thank you so much again!
 
Upvote 0
Re: "Code128" barcode generator in VBA - version 2

Try the sample. It works in my Excel 2007 on Win 7.

Hi all,
The sample has been updated. Thanks to TomeK712 a serious bug has been revealed which leaded to incorrect generation. Now it seems to be OK.
Please report any bugs here!
 
Last edited:
Upvote 0
Re: "Code128" barcode generator in VBA - version 2

Hello All,
Really sorry for any inconvenience but please dont use the code posted above.
Here is the latest sample of correct code which works on all data.
Please report any issues.
 
Upvote 0
Re: "Code128" barcode generator in VBA - version 2

Hello All,
Really sorry for any inconvenience but please dont use the code posted above.
Here is the latest sample of correct code which works on all data.
Please report any issues.

yakovleff, this is AMAZING!! Thanks so much for sharing this!
 
Upvote 0

Forum statistics

Threads
1,223,714
Messages
6,174,052
Members
452,542
Latest member
Bricklin

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