Rambler's Top100
Российский фонд помощи
Навигация
Главная
MS ACCESS
VB
ASP
PHP
Наши друзья
Поиск
Форум
Лента новостей
Новый сайт

Online
Сейчас на сайте находятся:
1 гость
Рассылки Subscribe.Ru
Работа с MS Access
Подписаться письмом
Реклама на сайте
 
Главная arrow MS ACCESS arrow Пример работы со штрих кодом EAN-13
Пример работы со штрих кодом EAN-13 Печать E-mail
Автор прислала Nadin   
24.06.2008 г.
  • Кодирование
  • Проверка контрольной суммы
  • Печать этикеток
  • Шрифт для печати

 

 

 


Download now
Просмотров: 14740

  Коментарии (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, 8) = 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, 8) = 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, 8) = 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, 8) = 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, 8) = 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, 8) = 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(88) 
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, 8) = 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, 8) = 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, 8) = 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, 8) = 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, 8) = 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, 8) = 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
Коментарий:



Код:* Code

 
Реклама на сайте
HiProg.com - Технологии программирования
Rambler's Top100 TopList