Page 1 of 4 123 ... LastLast
Results 1 to 10 of 32

Thread: "Code128" barcode generator in VBA

  1. #1
    New Member
    Join Date
    May 2013
    Posts
    21
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default "Code128" barcode generator in VBA

    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) * 0.9 -  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
    
    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

  2. #2
    New Member
    Join Date
    Feb 2016
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: "Code128" barcode generator in VBA

    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

  3. #3
    New Member
    Join Date
    May 2013
    Posts
    21
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: "Code128" barcode generator in VBA

    Quote Originally Posted by eiram View Post
    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:

    ByVal X As Single - horizontal coordinate in mm from the left edge of a sheet
    ByVal Y As Single - vertical coordinate in mm from the top edge of a sheet
    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


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

    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!

  4. #4
    New Member
    Join Date
    May 2013
    Posts
    21
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: "Code128" barcode generator in VBA

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




    8x labels at A4 sheet:


    16x labels at A4 sheet:

  5. #5
    New Member
    Join Date
    Feb 2016
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: "Code128" barcode generator in VBA

    Thank you!

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

  6. #6
    New Member
    Join Date
    Apr 2016
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Question Re: "Code128" barcode generator in VBA

    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)

  7. #7
    New Member
    Join Date
    May 2013
    Posts
    21
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: "Code128" barcode generator in VBA

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

  8. #8
    New Member
    Join Date
    May 2013
    Posts
    21
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default 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
    Last edited by yakovleff; Jun 7th, 2017 at 02:56 AM.

  9. #9
    New Member
    Join Date
    May 2013
    Posts
    21
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: "Code128" barcode generator in VBA

    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.

  10. #10
    MrExcel MVP Tetra201's Avatar
    Join Date
    Oct 2016
    Posts
    3,149
    Post Thanks / Like
    Mentioned
    9 Post(s)
    Tagged
    0 Thread(s)

    Default Re: "Code128" barcode generator in VBA

    @yakovleff:

    Just an FYI.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •