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
Printable View
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
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
Attachment 19433
You can check out the original post for more information
https://www.mrexcel.com/forum/excel-...ml#post4659015
Code: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