Пример работы со штрих кодом EAN-13
Автор прислала Nadin
24.06.2008 г.
Кодирование
Проверка контрольной суммы
Печать этикеток
Шрифт для печати
Просмотров: 16776
Коментарии (6)
1
Написал(а)
час
, в 13:08 19.09.2008
А как быть - если контрольная сумма = 10
2
Написал(а)
Надежда
, в 23:58 09.12.2008
Код я впоследствии немного подправила.
Option Compare Database
Option Explicit
' необходим шрифт EANG000.TTF
'переменная для считывания штрих кода
Public ShRedyKod As String
Public Function CheckBar(Bar As Currency) As Integer
'выcчитывает по первым 12 цифрам тринадцатую (контрольную сумму)
Dim Cod(12)
Dim c
Dim S
Dim I As Integer
If Len(Trim(str(Bar))) 12 Then
MsgBox "Штрих код должен содержать 12 цифр", vbCritical
Else
S = 0
For I = 1 To 12
c = Mid(Bar, I, 1)
S = S + IIf(I Mod 2 = 0, c * 3, c)
Next
S = S Mod 10
CheckBar = 10 - S
End If
End Function
Public Function EAN13(BarCode As String) As String
'Строку из 13 цифр преобразует в Штрих-код EAN-13.
'Делает проверку контрольной суммы.
'Необходим шрифт Code EAN/UPC.
Const a As Integer = 48
Const b As Integer = 65
Const c As Integer = 97
Const d As Integer = 75
Dim I As Integer
Dim Cod(13, 2) As Integer
Dim F(6, 10) As Integer
Dim strEAN13 As String
If Len(BarCode) 13 Then
EAN13 = ""
MsgBox "Штрих код за пределами отведенного диапазона.", vbExclamation, "Модуль работы со штрих-кодами"
Exit Function
End If
If Right(BarCode, 1) EAN13Check(BarCode) Then
EAN13 = ""
MsgBox "Ошибка контрольной суммы.", vbExclamation, "Модуль работы со штрих-кодами"
Exit Function
End If
F(1, 0) = a: F(1, 1) = a: F(1, 2) = a: F(1, 3) = a: F(1, 4) = a
F(1, 5) = a: F(1, 6) = a: F(1, 7) = a: F(1,
= a: F(1, 9) = a
F(2, 0) = a: F(2, 1) = a: F(2, 2) = a: F(2, 3) = a: F(2, 4) = b
F(2, 5) = b: F(2, 6) = b: F(2, 7) = b: F(2,
= b: F(2, 9) = b
F(3, 0) = a: F(3, 1) = b: F(3, 2) = b: F(3, 3) = b: F(3, 4) = a
F(3, 5) = b: F(3, 6) = b: F(3, 7) = a: F(3,
= a: F(3, 9) = b
F(4, 0) = a: F(4, 1) = a: F(4, 2) = b: F(4, 3) = b: F(4, 4) = a
F(4, 5) = a: F(4, 6) = b: F(4, 7) = b: F(4,
= b: F(4, 9) = a
F(5, 0) = a: F(5, 1) = b: F(5, 2) = a: F(5, 3) = b: F(5, 4) = b
F(5, 5) = a: F(5, 6) = a: F(5, 7) = a: F(5,
= b: F(5, 9) = b
F(6, 0) = a: F(6, 1) = b: F(6, 2) = b: F(6, 3) = a: F(6, 4) = b
F(6, 5) = b: F(6, 6) = a: F(6, 7) = b: F(6,
= a: F(6, 9) = a
For I = 1 To 13
Cod(I, 1) = VAL(Mid(BarCode, I, 1))
Next
For I = 2 To 7
Cod(I, 2) = F(I - 1, Cod(1, 1))
Next
strEAN13 = Chr(Cod(1, 1) + 75)
strEAN13 = strEAN13 + Chr(120)
For I = 2 To 7
strEAN13 = strEAN13 + Chr(Cod(I, 1) + Cod(I, 2))
Next
strEAN13 = strEAN13 + Chr(8
For I = 8 To 13
strEAN13 = strEAN13 + Chr(Cod(I, 1) + c)
Next
strEAN13 = strEAN13 + Chr(120)
EAN13 = strEAN13
End Function
'--------------------------------------------------------------------------------
Public Function EAN13Check(BarCode As String) As String
'Выcчитывает контрольную сумму штрих-кода EAN-13.
'Использует первые 12 символов передаваемой строки.
Dim Cod(12)
Dim c As Long
Dim S As Long
Dim I As Integer
S = 0
For I = 1 To 12
c = VAL(Mid(BarCode, I, 1))
S = S + IIf(I Mod 2 = 0, c * 3, c)
Next
S = S Mod 10
EAN13Check = Right(Trim(str(10 - S)), 1)
End Function
'--------------------------------------------------------------------------------
Public Function EAN13p36TT(BarCode As String) As String
'Строку из 13 цифр преобразует в Штрих-код EAN-13.
'Делает проверку контрольной суммы.
'Необходим шрифт Code EAN/UPC.
Const a As Integer = 48
Const b As Integer = 65
Const c As Integer = 97
Const d As Integer = 35
Dim I As Integer
Dim Cod(13, 2) As Integer
Dim F(6, 10) As Integer
Dim strEAN13 As String
If Len(BarCode) 13 Then
EAN13p36TT = ""
MsgBox "Штрих код за пределами отведенного диапазона.", vbExclamation, "Модуль работы со штрих-кодами"
Exit Function
End If
If Right(BarCode, 1) EAN13Check(BarCode) Then
EAN13p36TT = ""
MsgBox "Ошибка контрольной суммы.", vbExclamation, "Модуль работы со штрих-кодами"
Exit Function
End If
F(1, 0) = a: F(1, 1) = a: F(1, 2) = a: F(1, 3) = a: F(1, 4) = a
F(1, 5) = a: F(1, 6) = a: F(1, 7) = a: F(1,
= a: F(1, 9) = a
F(2, 0) = a: F(2, 1) = a: F(2, 2) = a: F(2, 3) = a: F(2, 4) = b
F(2, 5) = b: F(2, 6) = b: F(2, 7) = b: F(2,
= b: F(2, 9) = b
F(3, 0) = a: F(3, 1) = b: F(3, 2) = b: F(3, 3) = b: F(3, 4) = a
F(3, 5) = b: F(3, 6) = b: F(3, 7) = a: F(3,
= a: F(3, 9) = b
F(4, 0) = a: F(4, 1) = a: F(4, 2) = b: F(4, 3) = b: F(4, 4) = a
F(4, 5) = a: F(4, 6) = b: F(4, 7) = b: F(4,
= b: F(4, 9) = a
F(5, 0) = a: F(5, 1) = b: F(5, 2) = a: F(5, 3) = b: F(5, 4) = b
F(5, 5) = a: F(5, 6) = a: F(5, 7) = a: F(5,
= b: F(5, 9) = b
F(6, 0) = a: F(6, 1) = b: F(6, 2) = b: F(6, 3) = a: F(6, 4) = b
F(6, 5) = b: F(6, 6) = a: F(6, 7) = b: F(6,
= a: F(6, 9) = a
For I = 1 To 13
Cod(I, 1) = VAL(Mid(BarCode, I, 1))
Next
For I = 2 To 7
Cod(I, 2) = F(I - 1, Cod(1, 1))
Next
strEAN13 = Chr(Cod(1, 1) + 35)
strEAN13 = strEAN13 + Chr(33)
For I = 2 To 7
strEAN13 = strEAN13 + Chr(Cod(I, 1) + Cod(I, 2))
Next
strEAN13 = strEAN13 + Chr(45)
For I = 8 To 13
strEAN13 = strEAN13 + Chr(Cod(I, 1) + c)
Next
strEAN13 = strEAN13 + Chr(33)
EAN13p36TT = strEAN13
End Function
3
Написал(а)
Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script
, в 22:33 03.02.2009
С MS Access и Ean-8,13 я занимаюсь почти 2 года. То что выложила Надежда, спасибо. Но я добился скрипта меньше и проще. Вся работа на работе, завтра напишу пример и вышлю.
4
Написал(а)
час
, в 18:58 07.04.2009
Спасибо!!!!!!!
Пригодилось........
5
Написал(а)
Александр
, в 16:28 30.12.2010
Большое спасибо. Вы мне очень помогли.
6
Написал(а)
Giorgi
, в 09:18 08.06.2011
Большое спасибо !!!!!!
Добавить коментарий
Имя:
E-mail
Коментарий:
Код:
*
Коментарии (6)