Scribd
Upload
197 views

Vbacode 128

This document contains code for generating Code 128 barcodes. It defines an enumeration for the three character sets (A, B, C) used in Code 128 barcodes. An array stores the character mappings for each character set. Functions are included to get the character index, build the barcode string by encoding the input string and calculating a check digit, and calculate the barcode width.

Uploaded by

Mahsun Muhammadi
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
197 views

Vbacode 128

This document contains code for generating Code 128 barcodes. It defines an enumeration for the three character sets (A, B, C) used in Code 128 barcodes. An array stores the character mappings for each character set. Functions are included to get the character index, build the barcode string by encoding the input string and calculating a check digit, and calculate the barcode width.

Uploaded by

Mahsun Muhammadi
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 6

' ***

Made By Michael Ciurescu (CVMichael) ***


'Modified by Paulo Cunha (pcunha) to work with char128.ttf on word or excel on 1
6/05/2011
'the font at in http://grandzebu.net/index.php?page=/informatique/codbar-en/code
128.htm
' References:
' http://www.barcodeman.com/info/c128.php3
Private Enum eCode128Type
eCode128_CodeSetA = 1
eCode128_CodeSetB = 2
eCode128_CodeSetC = 3
End Enum
Private Type tCode
ASet As String
BSet As String
CSet As String
BarSpacePattern As String
End Type
Private CodeArr() As tCode
Private Sub Class_Initialize()
ReDim CodeArr(106)
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry

0, " ", " ", "00", Chr(32)


1, "!", "!", "01", Chr(33)
2, """", """", "02", Chr(34)
3, "#", "#", "03", Chr(35)
4, "$", "$", "04", Chr(36)
5, "%", "%", "05", Chr(37)
6, "&", "&", "06", Chr(38)
7, "'", "'", "07", Chr(39)
8, "(", "(", "08", Chr(40)
9, ")", ")", "09", Chr(41)
10, "*", "*", "10", Chr(42)
11, "+", "+", "11", Chr(43)
12, ",", ",", "12", Chr(44)
13, "-", "-", "13", Chr(45)
14, ".", ".", "14", Chr(46)
15, "/", "/", "15", Chr(47)
16, "0", "0", "16", Chr(48)
17, "1", "1", "17", Chr(49)
18, "2", "2", "18", Chr(50)
19, "3", "3", "19", Chr(51)
20, "4", "4", "20", Chr(52)
21, "5", "5", "21", Chr(53)
22, "6", "6", "22", Chr(54)
23, "7", "7", "23", Chr(55)
24, "8", "8", "24", Chr(56)
25, "9", "9", "25", Chr(57)
26, ":", ":", "26", Chr(58)
27, ";", ";", "27", Chr(59)
28, "<", "<", "28", Chr(60)
29, "=", "=", "29", Chr(61)
30, ">", ">", "30", Chr(62)
31, "?", "?", "31", Chr(63)

AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry

32,
33,
34,
35,
36,
37,
38,
39,
40,
41,
42,
43,
44,
45,
46,
47,
48,
49,
50,
51,
52,
53,
54,
55,
56,
57,
58,
59,
60,
61,
62,
63,
64,
65,
66,
67,
68,
69,
70,
71,
72,
73,
74,
75,
76,
77,
78,
79,
80,
81,
82,
83,
84,
85,
86,
87,
88,
89,
90,
91,

"@", "@", "32", Chr(64)


"A", "A", "33", Chr(65)
"B", "B", "34", Chr(66)
"C", "C", "35", Chr(67)
"D", "D", "36", Chr(68)
"E", "E", "37", Chr(69)
"F", "F", "38", Chr(70)
"G", "G", "39", Chr(71)
"H", "H", "40", Chr(72)
"I", "I", "41", Chr(73)
"J", "J", "42", Chr(74)
"K", "K", "43", Chr(75)
"L", "L", "44", Chr(76)
"M", "M", "45", Chr(77)
"N", "N", "46", Chr(78)
"O", "O", "47", Chr(79)
"P", "P", "48", Chr(80)
"Q", "Q", "49", Chr(81)
"R", "R", "50", Chr(82)
"S", "S", "51", Chr(83)
"T", "T", "52", Chr(84)
"U", "U", "53", Chr(85)
"V", "V", "54", Chr(86)
"W", "W", "55", Chr(87)
"X", "X", "56", Chr(88)
"Y", "Y", "57", Chr(89)
"Z", "Z", "58", Chr(90)
"[", "[", "59", Chr(91)
"\", "\", "60", Chr(92)
"]", "]", "61", Chr(93)
"^", "^", "62", Chr(94)
"_", "_", "63", Chr(95)
Chr(0), "`", "64", Chr(96) ' Null
Chr(1), "a", "65", Chr(97) ' SOH
Chr(2), "b", "66", Chr(98) ' STX
Chr(3), "c", "67", Chr(99) ' ETX
Chr(4), "d", "68", Chr(100) ' EOT
Chr(5), "e", "69", Chr(101) ' ENQ
Chr(6), "f", "70", Chr(102) ' ACK
Chr(7), "g", "71", Chr(103) ' BEL
Chr(8), "h", "72", Chr(104) ' BS
Chr(9), "i", "73", Chr(105) ' HT
Chr(10), "j", "74", Chr(106) ' LF
Chr(11), "k", "75", Chr(107) ' VT
Chr(12), "l", "76", Chr(108) ' FF
Chr(13), "m", "77", Chr(109) ' CR
Chr(14), "n", "78", Chr(110) ' SO
Chr(15), "o", "79", Chr(111) ' SI
Chr(16), "p", "80", Chr(112) ' DLE
Chr(17), "q", "81", Chr(113) ' DC1
Chr(18), "r", "82", Chr(114) ' DC2
Chr(19), "s", "83", Chr(115) ' DC3
Chr(20), "t", "84", Chr(116) ' DC4
Chr(21), "u", "85", Chr(117) ' NAK
Chr(22), "v", "86", Chr(118) ' SYN
Chr(23), "w", "87", Chr(119) ' ETB
Chr(24), "x", "88", Chr(120) ' CAN
Chr(25), "y", "89", Chr(121) ' EM
Chr(26), "z", "90", Chr(122) ' SUB
Chr(27), "{", "91", Chr(123) ' ESC

AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
AddEntry
End Sub

92, Chr(28), "|", "92", Chr(124) ' FS


93, Chr(29), "}", "93", Chr(125) ' GS
94, Chr(30), "~", "94", Chr(126) ' RS
95, Chr(31), Chr(127), "95", Chr(200) ' US, DEL
96, "FNC 3", "FNC 3", "96", Chr(201)
97, "FNC 2", "FNC 2", "97", Chr(202)
98, "SHIFT", "SHIFT", "98", Chr(203)
99, "CODE C", "CODE C", "99", Chr(204)
100, "CODE B", "FNC 4", "CODE B", Chr(205)
101, "FNC 4", "CODE A", "CODE A", Chr(206)
102, "FNC 1", "FNC 1", "FNC 1", Chr(207)
103, "Start A", "Start A", "Start A", Chr(208)
104, "Start B", "Start B", "Start B", Chr(209)
105, "Start C", "Start C", "Start C", Chr(210)
106, "Stop", "Stop", "Stop", Chr(211)

Private Sub AddEntry(ByVal Index As Integer, ASet As String, BSet As String, CSe
t As String, BarSpacePattern As String)
With CodeArr(Index)
.ASet = ASet
.BSet = BSet
.CSet = CSet
.BarSpacePattern = Replace(BarSpacePattern, " ", "")
End With
End Sub
Public Function Code128_Str(ByVal Str As String)
Code128_Str = Replace(BuildStr(Str), " ", "")
End Function
Private
Dim
Dim
Dim

Function BuildStr(ByVal Str As String) As String


SCode As eCode128Type, PrevSCode As eCode128Type
CurrChar As String, ArrIndex As Integer, CharIndex As Long
CheckDigit As Integer, CCodeIndex As Integer, TotalSum As Long

SCode = eCode128_CodeSetB
If Str Like "##*" Then SCode = eCode128_CodeSetC
TotalSum = 0
CharIndex = 1
Select Case SCode
Case eCode128_CodeSetA
TotalSum = TotalSum + (103 * CharIndex)
BuildStr = Trim(BuildStr) & Chr(208)
Case eCode128_CodeSetB
TotalSum = TotalSum + (104 * CharIndex)
BuildStr = Trim(BuildStr) & Chr(209)
Case eCode128_CodeSetC
TotalSum = TotalSum + (105 * CharIndex)
BuildStr = Trim(BuildStr) & Chr(210)
End Select
PrevSCode = SCode
Do Until Len(Str) = 0
If Str Like "####*" Then SCode = eCode128_CodeSetC
If SCode = eCode128_CodeSetC And Mid(Str, 1, 2) Like "##" Then

CurrChar = Mid(Str, 1, 2)
Else
CurrChar = Mid(Str, 1, 1)
End If
ArrIndex = GetCharIndex(CurrChar, SCode, True)
If ArrIndex <> -1 Then
If CodeArr(ArrIndex).BSet = CurrChar And
And CodeArr(ArrIndex).CSet <> CurrChar) Or (SCode =
rr(ArrIndex).ASet <> CurrChar)) Then
SCode = eCode128_CodeSetB
ElseIf CodeArr(ArrIndex).ASet = CurrChar
<> CurrChar Then
SCode = eCode128_CodeSetA
ElseIf CodeArr(ArrIndex).CSet = CurrChar
SCode = eCode128_CodeSetC
End If

((SCode = eCode128_CodeSetC
eCode128_CodeSetA And CodeA
And CodeArr(ArrIndex).BSet
Then

If PrevSCode <> SCode Then


Select Case SCode
Case eCode128_CodeSetA
CCodeIndex = GetCharIndex("CODE A", PrevSCode, False)
Case eCode128_CodeSetB
CCodeIndex = GetCharIndex("CODE B", PrevSCode, False)
Case eCode128_CodeSetC
CCodeIndex = GetCharIndex("CODE C", PrevSCode, False)
End Select
TotalSum = TotalSum + (CCodeIndex * CharIndex)
BuildStr = Trim(BuildStr) & CodeArr(CCodeIndex).BarSpacePattern
CharIndex = CharIndex + 1
PrevSCode = SCode
End If
BuildStr = Trim(BuildStr) & CodeArr(ArrIndex).BarSpacePattern
TotalSum = TotalSum + (ArrIndex * CharIndex)
CharIndex = CharIndex + 1
End If
If SCode = eCode128_CodeSetC Then
Str = Mid(Str, 3)
Else
Str = Mid(Str, 2)
End If
Loop
CheckDigit = TotalSum Mod 103
BuildStr = Trim(BuildStr) & CodeArr(CheckDigit).BarSpacePattern
BuildStr = Trim(BuildStr) & Chr(211)
End Function
Private Function GetCharIndex(ByVal Char As String, ByVal CodeType As eCode128Ty
pe, ByVal Recurse As Boolean) As Integer
Dim K As Long
Select Case CodeType

Case eCode128_CodeSetA
For K = 0 To UBound(CodeArr)
If Char = CodeArr(K).ASet Then Exit For
Next K
Case eCode128_CodeSetB
For K = 0 To UBound(CodeArr)
If Char = CodeArr(K).BSet Then Exit For
Next K
Case eCode128_CodeSetC
For K = 0 To UBound(CodeArr)
If Char = CodeArr(K).CSet Then Exit For
Next K
End Select
If K = UBound(CodeArr) + 1 Then
If Not Recurse Then
GetCharIndex = -1
Else
Select Case CodeType
Case eCode128_CodeSetA
GetCharIndex = GetCharIndex(Char, eCode128_CodeSetC, False)
Case eCode128_CodeSetB
GetCharIndex = GetCharIndex(Char, eCode128_CodeSetA, False)
Case eCode128_CodeSetC
GetCharIndex = GetCharIndex(Char, eCode128_CodeSetB, False)
End Select
If GetCharIndex = -1 Then
Select Case CodeType
Case eCode128_CodeSetA
GetCharIndex = GetCharIndex(Char, eCode128_CodeSetB, False)
Case eCode128_CodeSetB
GetCharIndex = GetCharIndex(Char, eCode128_CodeSetC, False)
Case eCode128_CodeSetC
GetCharIndex = GetCharIndex(Char, eCode128_CodeSetA, False)
End Select
End If
End If
Else
GetCharIndex = K
End If
End Function
Public Function Code128_GetWidth(ByVal Str As String, Optional ByVal BarWidth As
Integer = 1) As Long
Dim K As Long, Width As Long
Str = Replace(Code128_Str(Str), " ", "")
Debug.Print Str
For K = 1 To Len(Str)
Width = Width + Val(Mid(Str, K, 1))
Next K
Code128_GetWidth = Width * BarWidth + (28 * BarWidth)
End Function

Private Sub Class_Terminate()

End Sub

Public Function Code128_Str(ByVal Str As String) As String


Dim c As Class1
Set c = New Class1
Code128_Str = c.Code128_Str(Str)
End Function

You might also like