Sleeper: Barcode in the standard EAN-128

[Romulo Avila]

Good Morning,


I need to generate some barcode in the standard EAN-128, some forum participant would have an idea, I could not find the sources.


Thank you

[Paul_Hossler]

Not my field (or even close) but the reference seems to know what he's doing. Hope this is close to what you're looking for

Capture.JPG


You can check out the original post for more information

https://www.mrexcel.com/forum/excel-...ml#post4659015

Option Explicit
'https://www.mrexcel.com/forum/excel-questions/970865-excel-visual-basic-applications-barcode-generator.html#post4659015

Type BarParams
    Pos As Long
    Width As Byte
End Type

Sub test()
    Dim s As String
    Dim r As Range
    
    s = Code128B("ABC123")
    Set r = ActiveSheet.Range("C3")
    Call DrawBarcode(s, r.Left, r.Top, 2, 50)

End Sub
 
Sub DrawBarcode(EncStr As String, Left As Single, Top As Single, _
    SingleWidth As Single, Height As Single, Optional Color As Long)
'
' Parameters:
'
' EncStr - a string of ones and zeros, e.g., "11001011"
' Left - the position (in points) of the upper-left corner of the barcode
'        relative to the upper-left corner of the worksheet.
' Top - the position (in points) of the upper-left corner of the barcode
'       relative to the upper-left corner of the worksheet.
' SingleWidth - the width (in points) of a single-wide bar or space.
' Height - the height of the bars, in points.
' Color - (optional) the color of bars; if omitted, the color vill be black.
'
Dim TgtSht As Worksheet
Dim Bars() As BarParams
Dim NextBar As Boolean
Dim i, j As Long
Dim BarColl() As Variant
'
Set TgtSht = ActiveSheet
'
ReDim Bars(1 To 1)
Bars(1).Width = 0
NextBar = False
j = 1
'
For i = 1 To Len(EncStr) Step 1
    If Mid(EncStr, i, 1) = "1" Then
        If Not NextBar Then Bars(j).Pos = i
        Bars(j).Width = Bars(j).Width + 1
        NextBar = True
    Else
        If NextBar Then
            j = j + 1
            ReDim Preserve Bars(1 To j)
            Bars(j).Width = 0
        End If
        NextBar = False
    End If
Next i
'
ReDim BarColl(1 To j)
'
For i = 1 To j Step 1
    With TgtSht.Shapes.AddShape(msoShapeRectangle, _
        Left + (Bars(i).Pos - 1) * SingleWidth, Top, _
        Bars(i).Width * SingleWidth, Height)
        .Line.Visible = msoFalse
        .Fill.ForeColor.RGB = Color
        BarColl(i) = .Name
    End With
Next i
'
TgtSht.Shapes.Range(BarColl).Group
'
End Sub
Function Code128B(TxtStr As String) As String
'
' Parameters
'
' TxtSrt - an alphanumeric string; Chr(32) to Chr(106) can be used.
'
Const MaxChB = 94
'
Dim i, j As Long
Dim SymChB(0 To MaxChB) As String * 1
Dim SymEnc As Variant
Dim WgtSum As Long
Dim EncStr As String
'
For i = 0 To 94
    SymChB(i) = Chr(i + 32)
Next i
'
SymEnc = Array( _
    "11011001100", "11001101100", "11001100110", "10010011000", "10010001100", _
    "10001001100", "10011001000", "10011000100", "10001100100", "11001001000", _
    "11001000100", "11000100100", "10110011100", "10011011100", "10011001110", _
    "10111001100", "10011101100", "10011100110", "11001110010", "11001011100", _
    "11001001110", "11011100100", "11001110100", "11101101110", "11101001100", _
    "11100101100", "11100100110", "11101100100", "11100110100", "11100110010", _
    "11011011000", "11011000110", "11000110110", "10100011000", "10001011000", _
    "10001000110", "10110001000", "10001101000", "10001100010", "11010001000", _
    "11000101000", "11000100010", "10110111000", "10110001110", "10001101110", _
    "10111011000", "10111000110", "10001110110", "11101110110", "11010001110", _
    "11000101110", "11011101000", "11011100010", "11011101110", "11101011000", _
    "11101000110", "11100010110", "11101101000", "11101100010", "11100011010", _
    "11101111010", "11001000010", "11110001010", "10100110000", "10100001100", _
    "10010110000", "10010000110", "10000101100", "10000100110", "10110010000", _
    "10110000100", "10011010000", "10011000010", "10000110100", "10000110010", _
    "11000010010", "11001010000", "11110111010", "11000010100", "10001111010", _
    "10100111100", "10010111100", "10010011110", "10111100100", "10011110100", _
    "10011110010", "11110100100", "11110010100", "11110010010", "11011011110", _
    "11011110110", "11110110110", "10101111000", "10100011110", "10001011110", _
    "10111101000", "10111100010", "11110101000", "11110100010", "10111011110", _
    "10111101110", "11101011110", "11110101110", "11010000100", "11010010000", _
    "11010011100", "11000111010")
ReDim Preserve SymEnc(0 To 106)
'
WgtSum = 104 ' START-B
EncStr = EncStr + SymEnc(104)
For i = 1 To Len(TxtStr) Step 1
    j = 0
    Do While (Mid(TxtStr, i, 1) <> SymChB(j)) And (j <= MaxChB)
        j = j + 1
    Loop
    If j > MaxChB Then j = 0
    WgtSum = WgtSum + i * j
    EncStr = EncStr + SymEnc(j)
Next i
Code128B = EncStr + SymEnc(WgtSum Mod 103) + SymEnc(106) + "11"
'
End Function