Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
29.03.2024, 10:29:32

Войти
На форуме добавлена возможность подписки на RSS-ленты любого раздела форума. Подписаться можно, нажав на иконку RSS , расположенную левее наименования раздела.
33 233 Сообщений в 5 454 Тем от 6 750 Пользователей
Последний пользователь: Alex1210
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Полезные решения
| | |-+  Генератор штрихкодов в формате Code 93 на Excel VBA
Страниц: [1]   Вниз
Печать
Автор Тема: Генератор штрихкодов в формате Code 93 на Excel VBA  (Прочитано 16367 раз)
0 Пользователей и 1 Гость смотрят эту тему.
yakovleff
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 4


Просмотр профиля
« : 27.05.2013, 22:55:34 »

Всем привет,

(Кросспост с: Code 93 barcode generator in VBA)

Недавно сделал небольшую процедуру отрисовки штрихкода формата Code 93 для небольшой задачи по работе. Хочу поделиться с форумчанами и теми, кто будет гуглить подобную тему.  ;)

Описание:
- Алгоритм расчета взят с CODE 93 SYMBOLOGY;
- Процедура использует коллекцию Shapes  для отрисовки линий штрихкода вместо использования специальных шрифтов;
- Процедура рисует штрихкод на указанный лист, начиная с верхнего левого угла (начальной точки); положение точки определяется горизонтальной координатой (X) в мм, вертикальной координатой (Y) в мм, высотой штрихкода в мм и толщиной линии в пунктах (pt);

Недоработки:
- Процедура кодирует только символы основного списка (значения символов от 0 до 46);
- Если попадается символ, отличный от этого перечня, процедура завершается без какого-либо сообщения;
- Процедура не проверяет длину кодируемой строки: если длина более 20 символов, штрихкод будет кодироваться неверно;
- Ширина штрихкода не высчитывается заранее и отрисовка начинается слева, так что в случае кодирования длинных строк возможны нежелательные вылеты;
- Процедура не поддерживает наклон (поворот) штрихкода - линии расположены только вертикально, а сам код - горизонтально.
- Положение штрихкода на напечатанной странице адекватно, если установлен масштаб печати 100%;
- Судя по всему, код зависим от версии Excel/принтера (разные версии могут давать разные результаты, хотя НЕ тестировалось).

При разработке использовались Win 7 Ultimate, MS Office 2007.
Сам код:
spoiler for Hiden:
Код: (vb)

Sub Code93Generate(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, TargetSheet As Worksheet, ByVal Content As String)
' X - начальная точка по горизонтали в мм
' Y - начальная точка по вертикали в мм
' Height  - высота в мм
' LineWeight  - толщина линии штриха в pt
' Content  = кодируемая строка


Dim SSSymbol As String 'старт/стоп символ
Const Tbar_Symbol As String = "1" 'termination bar


Dim CurBar As Integer ' индекс текущего штриха
Dim SymbolChar(0 To 46) As String * 1 'кодируемые символы
Dim SymbolValue(0 To 46) As Integer ' значения символов
Dim SymbolString(0 To 46) As String * 9 ' "битовая" последовательность символа
Dim C_WeightSum As Single
Dim K_WeightSum As Single
Dim C_CheckSum As Integer 'контрольная сумма C
Dim K_CheckSum As Integer 'контрольная сумма K
Dim ContentString As String '"битовая" последовательность всего штрихкода
Dim i, j, k As Integer 'переменные циклов


SSSymbol = "101011110"


For i = 0 To 46
    SymbolValue(i) = i
Next i
For i = 0 To 9 'цифры
    SymbolChar(i) = i
Next i
For i = 10 To 35 'символы
    SymbolChar(i) = Chr(i + 55)
Next i
SymbolChar(36) = "-"
SymbolChar(37) = "."
SymbolChar(38) = " "
SymbolChar(39) = "$"
SymbolChar(40) = "/"
SymbolChar(41) = "+"
SymbolChar(42) = "%"
SymbolChar(43) = "$"
SymbolChar(44) = "%"
SymbolChar(45) = "/"
SymbolChar(46) = "+"


SymbolString(0) = "100010100"
SymbolString(1) = "101001000"
SymbolString(2) = "101000100"
SymbolString(3) = "101000010"
SymbolString(4) = "100101000"
SymbolString(5) = "100100100"
SymbolString(6) = "100100010"
SymbolString(7) = "101010000"
SymbolString( 8 ) = "100010010"
SymbolString(9) = "100001010"
SymbolString(10) = "110101000"
SymbolString(11) = "110100100"
SymbolString(12) = "110100010"
SymbolString(13) = "110010100"
SymbolString(14) = "110010010"
SymbolString(15) = "110001010"
SymbolString(16) = "101101000"
SymbolString(17) = "101100100"
SymbolString(18) = "101100010"
SymbolString(19) = "100110100"
SymbolString(20) = "100011010"
SymbolString(21) = "101011000"
SymbolString(22) = "101001100"
SymbolString(23) = "101000110"
SymbolString(24) = "100101100"
SymbolString(25) = "100010110"
SymbolString(26) = "110110100"
SymbolString(27) = "110110010"
SymbolString(28) = "110101100"
SymbolString(29) = "110100110"
SymbolString(30) = "110010110"
SymbolString(31) = "110011010"
SymbolString(32) = "101101100"
SymbolString(33) = "101100110"
SymbolString(34) = "100110110"
SymbolString(35) = "100111010"
SymbolString(36) = "100101110"
SymbolString(37) = "111010100"
SymbolString(38) = "111010010"
SymbolString(39) = "111001010"
SymbolString(40) = "101101110"
SymbolString(41) = "101110110"
SymbolString(42) = "110101110"
SymbolString(43) = "100100110"
SymbolString(44) = "111011010"
SymbolString(45) = "111010110"
SymbolString(46) = "100110010"


X = X / 0.376042 'коэффициент перевода mm в pt по горизонтали, измерен печатью линий на лист A4, может варьироваться на разных PC/принтерах.
Y = Y / 0.341 'коэффициент перевода mm в pt по вертикали, измерен печатью линий на лист A4, может варьироваться на разных PC/принтерах.
'Не знаю почему, но коэффициенты по X и Y разные, но они разные...
Height = Height / 0.341 'mm в pt
Content = UCase(Content) ' UCase использован для перевода любых строк в кодируемые символы

' Расчкт контрольной суммы C
For i = 1 To Len(Content)
    j = -1
    Do ' поиск значения символа
        If j > 46 Then Exit Sub 'Если обнаружен некодируемый символ, выход из процедуры!
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    C_WeightSum = C_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i)
Next i
C_CheckSum = C_WeightSum Mod 47


Content = Content + SymbolChar(C_CheckSum)


'Расчет контрольной суммы K
For i = 1 To Len(Content)
    j = -1
    Do ' searching for a character value
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    K_WeightSum = K_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i)
Next i
K_CheckSum = K_WeightSum Mod 47


Content = Content + SymbolChar(K_CheckSum)
ContentString = SSSymbol


For i = 1 To Len(Content)
   j = -1
    Do ' поиск каждого символа в последовательности
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    ContentString = ContentString + SymbolString(j)
Next i
ContentString = ContentString + SSSymbol + Tbar_Symbol


'Отрисовка штрихкода
CurBar = 1


For i = 1 To Len(ContentString)
    Select Case Mid(ContentString, i, 1)
    Case 0
        CurBar = CurBar + 1
    Case 1
        CurBar = CurBar + 1
        TargetSheet.Shapes.AddLine X + CurBar * LineWeight, Y, X + CurBar * LineWeight, (Y + Height)
        TargetSheet.Shapes(ActiveSheet.Shapes.Count).Line.Weight = LineWeight
        TargetSheet.Shapes(ActiveSheet.Shapes.Count).Line.ForeColor.RGB = vbBlack ' разные версии Excel имеют свой умолчальный цвет линий, так что 'устанавливаем черный принудительно

    End Select
Next i

End Sub


Тестирование генерации производилось сканированием штрихкодов смартфоном на Андроиде (программой Accusoft Barcode Scanner) и беспроводным сканером PROTON IMS-3100.

Надеюсь, что код пригодится кому-то :)

Yakovleff
« Последнее редактирование: 27.05.2013, 23:18:14 от The_Prist » Записан
yakovleff
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 4


Просмотр профиля
« Ответ #1 : 13.06.2014, 10:15:31 »

Привет!

За год использования были найдены следующие баги и внесены следующие изменения:
1. От пользователей были получены жалобы на плохое чтение штихкодов: коды хорошо читались с относительно большого расстояния, что не всегда удобно. Я нашел причину в том, что Excel (в моем случае - 2007) печатает линии с маленьким промежутком порядка 0,1-0,05 мм, который можно легко увидеть не печати, несмотря на то что код генерирует линии "в стык".  Судя по всему, это является препятствием для чтения кодо в малого расстояния - сканер не в состоянии декодировать последовательность.
Данный баг починил тем, что теперь линии печатаются на 10% ближе друг к другу. Это значение было экспериментально подобрано для моего PROTON как наилучшее. Возможно, в вашем случае будет по-другому.
2. Если штрихи рисуются на листе, на котором уже находятся другие графические элементы (кнопки и пр.), цвет и толщина линий почему-то устанавливались некорректно. Посему применен новый метод рисования линий.
3. Начал получать жалобы, что некоторые последовательности штрихов не читаются никакими средствами. Изучая вопрос, нашел большой баг в алгоритме.
Баг заключается в кодировании символов 43-46. В стандарте написано:
Цитировать
Note that the characters ($), (%), (/), and (+) are special characters that are used to encode all 128 ASCII characters using Code 93's Full ASCII mode.
In Code 39, four of the characters ($, %, /, and +) are used to optionally encode all 128 characters-but there is no way to know whether those characters are being used as shift characters in Full ASCII mode or whether they are being used to represent $, %, /, and +. In Code 93 this problem is solved by reserving these four special characters exclusively to "shift" into Full ASCII mode.
Поискав в различных ресурсах на тему ASCII-кодов, так и не нашел какие ASCII-коды соответствуют этим "волшебным" символам. Поэтому ранее использовал те же символы, что и для значений 39-42:
Цитировать
SymbolChar(39) = "$"
SymbolChar(40) = "/"
SymbolChar(41) = "+"
SymbolChar(42) = "%"
SymbolChar(43) = "$"
SymbolChar(44) = "%"
SymbolChar(45) = "/"
SymbolChar(46) = "+"

Это привело к тому, что в контрольные суммы записывались неверные символы и сканер не мог правильно раскодировать штрихкод.
Проблема решилась применением кодирования символов, НЕ ВХОДЯЩИХ в стандарт Code93:
Цитировать
SymbolChar(43) = Chr(60)
SymbolChar(44) = Chr(61)
SymbolChar(45) = Chr(62)
SymbolChar(46) = Chr(63)
В работе алгоритма в конечном счёте эти символы являются всего лишь ссылками на битовые последовательности и не являются "читаемыми" символами и не попадают в раскодированную строку.
4. Подсчёт контрольных сумм С и К приведен в соответствие со стандартом:
Цитировать
The "C" checksum character is the modulo 47 remainder of the sum of the weighted value of the data characters. The weighting value starts at "1" for the right-most data character, 2 for the second to last, 3 for the third-to-last, and so on up to 20. After 20, the sequence wraps around back to 1.
The "K" checksum character is calculated in basically the same way except that the weighting goes from 1 to 15. Also, the right-most character is now the "C" checksum character which was calculated in the step above.
Всё это привело к тому, что код стал работать правильно.
Окончательная версия кода. Красным показаны изменения:

Код: (vb)
Sub Code93Generate(ByVal X As Single, ByVal Y As Single, ByVal Height As Single, ByVal LineWeight As Single, _
                  ByRef TargetSheet As Worksheet, ByVal Content As String)
' X in mm (0.376042)
' Y in mm (0.341)
' Height in mm
' LineWeight in pt

Dim SSSymbol As String
Const Tbar_Symbol As String = "1"

Dim CurBar As Integer
Dim SymbolChar(0 To 46) As String
Dim SymbolValue(0 To 46) As Integer
Dim SymbolString(0 To 46) As String * 9
Dim C_WeightSum As Single
Dim C_WeightIndex, K_WeightIndex As Integer 'weight indexes
Dim K_WeightSum As Single
Dim C_CheckSum As Single
Dim K_CheckSum As Single
Dim ContentString As String
Dim i, j, k As Integer

SSSymbol = "101011110"

For i = 0 To 46
    SymbolValue(i) = i
Next i
For i = 0 To 9 'digits
    SymbolChar(i) = i
Next i
For i = 10 To 35 'digits
    SymbolChar(i) = Chr(i + 55)
Next i
SymbolChar(36) = "-"
SymbolChar(37) = "."
SymbolChar(38) = " "
SymbolChar(39) = "$"
SymbolChar(40) = "/"
SymbolChar(41) = "+"
SymbolChar(42) = "%"
SymbolChar(43) = Chr(60)
SymbolChar(44) = Chr(61)
SymbolChar(45) = Chr(62)
SymbolChar(46) = Chr(63)


SymbolString(0) = "100010100"
SymbolString(1) = "101001000"
SymbolString(2) = "101000100"
SymbolString(3) = "101000010"
SymbolString(4) = "100101000"
SymbolString(5) = "100100100"
SymbolString(6) = "100100010"
SymbolString(7) = "101010000"
SymbolString(8 ) = "100010010"
SymbolString(9) = "100001010"
SymbolString(10) = "110101000"
SymbolString(11) = "110100100"
SymbolString(12) = "110100010"
SymbolString(13) = "110010100"
SymbolString(14) = "110010010"
SymbolString(15) = "110001010"
SymbolString(16) = "101101000"
SymbolString(17) = "101100100"
SymbolString(18) = "101100010"
SymbolString(19) = "100110100"
SymbolString(20) = "100011010"
SymbolString(21) = "101011000"
SymbolString(22) = "101001100"
SymbolString(23) = "101000110"
SymbolString(24) = "100101100"
SymbolString(25) = "100010110"
SymbolString(26) = "110110100"
SymbolString(27) = "110110010"
SymbolString(28) = "110101100"
SymbolString(29) = "110100110"
SymbolString(30) = "110010110"
SymbolString(31) = "110011010"
SymbolString(32) = "101101100"
SymbolString(33) = "101100110"
SymbolString(34) = "100110110"
SymbolString(35) = "100111010"
SymbolString(36) = "100101110"
SymbolString(37) = "111010100"
SymbolString(38) = "111010010"
SymbolString(39) = "111001010"
SymbolString(40) = "101101110"
SymbolString(41) = "101110110"
SymbolString(42) = "110101110"
SymbolString(43) = "100100110"
SymbolString(44) = "111011010"
SymbolString(45) = "111010110"
SymbolString(46) = "100110010"

X = X / 0.376042 'mm to pt
Y = Y / 0.341 'mm to pt
Height = Height / 0.341 'mm to pt
Content = UCase(Content)

'C checksum counting
C_WeightIndex = Len(Content) Mod 20
If C_WeightIndex = 0 Then C_WeightIndex = 20
For i = 1 To Len(Content)
    j = -1
    Do
        If j > 46 Then Exit Sub
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    'C_WeightSum = C_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i) ' 20
    C_WeightSum = C_WeightSum + SymbolValue(j) * C_WeightIndex
    C_WeightIndex = C_WeightIndex - 1
    If C_WeightIndex = 0 Then C_WeightIndex = 20
Next i
C_CheckSum = C_WeightSum Mod 47

Content = Content + SymbolChar(C_CheckSum)

'K checksum counting
K_WeightIndex = Len(Content) Mod 15
If K_WeightIndex = 0 Then C_WeightIndex = 15

For i = 1 To Len(Content)
    j = -1
    Do
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    'K_WeightSum = K_WeightSum + SymbolValue(j) * (Len(Content) + 1 - i) ' 15
    K_WeightSum = K_WeightSum + SymbolValue(j) * K_WeightIndex ' 15
    K_WeightIndex = K_WeightIndex - 1
    If K_WeightIndex = 0 Then K_WeightIndex = 15
Next i

K_CheckSum = K_WeightSum Mod 47

Content = Content + SymbolChar(K_CheckSum)
ContentString = SSSymbol

For i = 1 To Len(Content)
   j = -1
    Do
        j = j + 1
    Loop While Mid(Content, i, 1) <> SymbolChar(j)
    ContentString = ContentString + SymbolString(j)
Next i
ContentString = ContentString + SSSymbol + Tbar_Symbol

'Barcode drawing
CurBar = 0

For i = 1 To Len(ContentString)
    Select Case Mid(ContentString, i, 1)
    Case 0
        CurBar = CurBar + 1
    Case 1
        CurBar = CurBar + 1
        With TargetSheet.Shapes.AddLine(X + (CurBar * LineWeight) * 0.9, Y, X + (CurBar * LineWeight) * 0.9, (Y + Height)).Line
        .Weight = LineWeight
        .ForeColor.RGB = vbBlack

        End With
    End Select
Next i

End Sub


На этом разработку кода планирую завершить, так как CODE93 довольно старомоден. Переключусь на Code128!
Yakovleff
Записан
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru