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

19433


You can check out the original post for more information

https://www.mrexcel.com/forum/excel-questions/970865-excel-visual-basic-applications-barcode-generator.html#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