Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Создать штрих-код EAN-8 - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Создать штрих-код EAN-8
JohnnyTaylor Дата: Среда, 22.11.2023, 05:10 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

2019
Здравствуйте! Нужно создать штрих-код EAN-8 с помощью формулы. Есть шрифт EAN-13 и два разных кода которые преобразуют цифры в штрих-код и выдают одинаковый результат, нужна помощь в написании формулы для штрих-кода EAN-8. Помогите, не могу разобраться!

Код
=СЦЕПИТЬ(ЗНАЧЕН(ПСТР(A12;1;1));СИМВОЛ(ЗНАЧЕН(ПСТР(A12;2;1))+65);ЕСЛИ(ЗНАЧЕН(ПСТР(A12;1;1))<4;СИМВОЛ(ЗНАЧЕН(ПСТР(A12;3;1))+65);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;3;1))+75));ЕСЛИ(ИЛИ(ЗНАЧЕН(ПСТР(A12;1;1))=0;ЗНАЧЕН(ПСТР(A12;1;1))=4;ЗНАЧЕН(ПСТР(A12;1;1))=7;ЗНАЧЕН(ПСТР(A12;1;1))=8);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;4;1))+65);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;4;1))+75));ЕСЛИ(ИЛИ(ЗНАЧЕН(ПСТР(A12;1;1))=0;ЗНАЧЕН(ПСТР(A12;1;1))=1;ЗНАЧЕН(ПСТР(A12;1;1))=4;ЗНАЧЕН(ПСТР(A12;1;1))=5;ЗНАЧЕН(ПСТР(A12;1;1))=9);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;5;1))+65);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;5;1))+75));ЕСЛИ(ИЛИ(ЗНАЧЕН(ПСТР(A12;1;1))=0;ЗНАЧЕН(ПСТР(A12;1;1))=2;ЗНАЧЕН(ПСТР(A12;1;1))=5;ЗНАЧЕН(ПСТР(A12;1;1))=6;ЗНАЧЕН(ПСТР(A12;1;1))=7);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;6;1))+65);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;6;1))+75));ЕСЛИ(ИЛИ(ЗНАЧЕН(ПСТР(A12;1;1))=0;ЗНАЧЕН(ПСТР(A12;1;1))=3;ЗНАЧЕН(ПСТР(A12;1;1))=6;ЗНАЧЕН(ПСТР(A12;1;1))=8;ЗНАЧЕН(ПСТР(A12;1;1))=9);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;7;1))+65);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;7;1))+75));"*";СИМВОЛ(ЗНАЧЕН(ПСТР(A12;8;1))+97);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;9;1))+97);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;10;1))+97);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;11;1))+97);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;12;1))+97);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;13;1))+97);"+")

Код
=ЛЕВБ(A13)&СИМВОЛ(ПСТР(A13;2;1)+65)&СИМВОЛ((--ЛЕВБ(A13)>3)*10+65+ПСТР(A13;3;1))&СИМВОЛ(ПСТР(A13;4;1)+75-ЕЧИСЛО(ПОИСК(ЛЕВБ(A13);"0478"))*10)&СИМВОЛ(ПСТР(A13;5;1)+75-ЕЧИСЛО(ПОИСК(ЛЕВБ(A13);"01459"))*10)&СИМВОЛ(ПСТР(A13;6;1)+75-ЕЧИСЛО(ПОИСК(ЛЕВБ(A13);"02567"))*10)&СИМВОЛ(ПСТР(A13;7;1)+75-ЕЧИСЛО(ПОИСК(ЛЕВБ(A13);"03689"))*10)&"*"&СИМВОЛ(ПСТР(A13;8;1)+97)&СИМВОЛ(ПСТР(A13;9;1)+97)&СИМВОЛ(ПСТР(A13;10;1)+97)&СИМВОЛ(ПСТР(A13;11;1)+97)&СИМВОЛ(ПСТР(A13;12;1)+97)&СИМВОЛ(ПСТР(A13;13;1)+97)&"+"
 
Ответить
СообщениеЗдравствуйте! Нужно создать штрих-код EAN-8 с помощью формулы. Есть шрифт EAN-13 и два разных кода которые преобразуют цифры в штрих-код и выдают одинаковый результат, нужна помощь в написании формулы для штрих-кода EAN-8. Помогите, не могу разобраться!

Код
=СЦЕПИТЬ(ЗНАЧЕН(ПСТР(A12;1;1));СИМВОЛ(ЗНАЧЕН(ПСТР(A12;2;1))+65);ЕСЛИ(ЗНАЧЕН(ПСТР(A12;1;1))<4;СИМВОЛ(ЗНАЧЕН(ПСТР(A12;3;1))+65);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;3;1))+75));ЕСЛИ(ИЛИ(ЗНАЧЕН(ПСТР(A12;1;1))=0;ЗНАЧЕН(ПСТР(A12;1;1))=4;ЗНАЧЕН(ПСТР(A12;1;1))=7;ЗНАЧЕН(ПСТР(A12;1;1))=8);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;4;1))+65);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;4;1))+75));ЕСЛИ(ИЛИ(ЗНАЧЕН(ПСТР(A12;1;1))=0;ЗНАЧЕН(ПСТР(A12;1;1))=1;ЗНАЧЕН(ПСТР(A12;1;1))=4;ЗНАЧЕН(ПСТР(A12;1;1))=5;ЗНАЧЕН(ПСТР(A12;1;1))=9);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;5;1))+65);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;5;1))+75));ЕСЛИ(ИЛИ(ЗНАЧЕН(ПСТР(A12;1;1))=0;ЗНАЧЕН(ПСТР(A12;1;1))=2;ЗНАЧЕН(ПСТР(A12;1;1))=5;ЗНАЧЕН(ПСТР(A12;1;1))=6;ЗНАЧЕН(ПСТР(A12;1;1))=7);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;6;1))+65);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;6;1))+75));ЕСЛИ(ИЛИ(ЗНАЧЕН(ПСТР(A12;1;1))=0;ЗНАЧЕН(ПСТР(A12;1;1))=3;ЗНАЧЕН(ПСТР(A12;1;1))=6;ЗНАЧЕН(ПСТР(A12;1;1))=8;ЗНАЧЕН(ПСТР(A12;1;1))=9);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;7;1))+65);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;7;1))+75));"*";СИМВОЛ(ЗНАЧЕН(ПСТР(A12;8;1))+97);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;9;1))+97);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;10;1))+97);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;11;1))+97);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;12;1))+97);СИМВОЛ(ЗНАЧЕН(ПСТР(A12;13;1))+97);"+")

Код
=ЛЕВБ(A13)&СИМВОЛ(ПСТР(A13;2;1)+65)&СИМВОЛ((--ЛЕВБ(A13)>3)*10+65+ПСТР(A13;3;1))&СИМВОЛ(ПСТР(A13;4;1)+75-ЕЧИСЛО(ПОИСК(ЛЕВБ(A13);"0478"))*10)&СИМВОЛ(ПСТР(A13;5;1)+75-ЕЧИСЛО(ПОИСК(ЛЕВБ(A13);"01459"))*10)&СИМВОЛ(ПСТР(A13;6;1)+75-ЕЧИСЛО(ПОИСК(ЛЕВБ(A13);"02567"))*10)&СИМВОЛ(ПСТР(A13;7;1)+75-ЕЧИСЛО(ПОИСК(ЛЕВБ(A13);"03689"))*10)&"*"&СИМВОЛ(ПСТР(A13;8;1)+97)&СИМВОЛ(ПСТР(A13;9;1)+97)&СИМВОЛ(ПСТР(A13;10;1)+97)&СИМВОЛ(ПСТР(A13;11;1)+97)&СИМВОЛ(ПСТР(A13;12;1)+97)&СИМВОЛ(ПСТР(A13;13;1)+97)&"+"

Автор - JohnnyTaylor
Дата добавления - 22.11.2023 в 05:10
DrMini Дата: Среда, 22.11.2023, 05:23 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1734
Репутация: 236 ±
Замечаний: 0% ±

Excel LTSC 2024 RUS
Здравствуйте JohnnyTaylor,
нужна помощь в написании формулы для штрих-кода EAN-8. Помогите, не могу разобраться!

Посмотрите тут.
 
Ответить
СообщениеЗдравствуйте JohnnyTaylor,
нужна помощь в написании формулы для штрих-кода EAN-8. Помогите, не могу разобраться!

Посмотрите тут.

Автор - DrMini
Дата добавления - 22.11.2023 в 05:23
JohnnyTaylor Дата: Среда, 22.11.2023, 05:35 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

2019
DrMini, смотрел, там речь про контрольную цифру, а нужно графическое отображение с помощью формулы и шрифта
 
Ответить
СообщениеDrMini, смотрел, там речь про контрольную цифру, а нужно графическое отображение с помощью формулы и шрифта

Автор - JohnnyTaylor
Дата добавления - 22.11.2023 в 05:35
DrMini Дата: Среда, 22.11.2023, 07:30 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1734
Репутация: 236 ±
Замечаний: 0% ±

Excel LTSC 2024 RUS
там речь про контрольную цифру

Не только про неё.
нужно графическое отображение с помощью формулы и шрифта

Нашёл файл на VBA. Вдруг подойдёт.
К сообщению приложен файл: shtrikh_kody.xls (62.5 Kb)
 
Ответить
Сообщение
там речь про контрольную цифру

Не только про неё.
нужно графическое отображение с помощью формулы и шрифта

Нашёл файл на VBA. Вдруг подойдёт.

Автор - DrMini
Дата добавления - 22.11.2023 в 07:30
JohnnyTaylor Дата: Среда, 22.11.2023, 13:00 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

2019
DrMini, макрос работает, но он создает много графических линий, что не очень удобно во время редактирования таблицы в дальнейшем. Есть такой макрос, но не могу найти аналогичный для EAN-8:

[vba]
Код
Public Function ean13$(chaine$)
  'V 1.0
  'Parameters: a 12-digit string
  'Return: * a chain which, displayed with the EAN13.TTF font, gives the barcode
  '         * an empty string if parameter supplied incorrect
  Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
  ean13$ = ""
  'Check that there are 12 characters
  If Len(chaine$) = 12 Then
    'And that these are many figures
    For i% = 1 To 12
      If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then
        i% = 0
        Exit For
      End If
    Next
    If i% = 13 Then
      'Calculation of the control key
      For i% = 2 To 12 Step 2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      checksum% = checksum% * 3
      For i% = 1 To 11 Step 2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
      'The first number is taken as is, the second comes from table A
      CodeBarre$ = Left$(chaine$, 1) & Chr$(65 + Val(Mid$(chaine$, 2, 1)))
      first% = Val(Left$(chaine$, 1))
      For i% = 3 To 7
        tableA = False
         Select Case i%
         Case 3
           Select Case first%
           Case 0 To 3
             tableA = True
           End Select
         Case 4
           Select Case first%
           Case 0, 4, 7, 8
             tableA = True
           End Select
         Case 5
           Select Case first%
           Case 0, 1, 4, 5, 9
             tableA = True
           End Select
         Case 6
           Select Case first%
           Case 0, 2, 5, 6, 7
             tableA = True
           End Select
         Case 7
           Select Case first%
           Case 0, 3, 6, 8, 9
             tableA = True
           End Select
         End Select
       If tableA Then
         CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
       Else
         CodeBarre$ = CodeBarre$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))
       End If
     Next
      CodeBarre$ = CodeBarre$ & "*"   'Adding central divider
      For i% = 8 To 13
        CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "+"   'Addition of end mark
      ean13$ = CodeBarre$
    End If
  End If
End Function
[/vba]
 
Ответить
СообщениеDrMini, макрос работает, но он создает много графических линий, что не очень удобно во время редактирования таблицы в дальнейшем. Есть такой макрос, но не могу найти аналогичный для EAN-8:

[vba]
Код
Public Function ean13$(chaine$)
  'V 1.0
  'Parameters: a 12-digit string
  'Return: * a chain which, displayed with the EAN13.TTF font, gives the barcode
  '         * an empty string if parameter supplied incorrect
  Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
  ean13$ = ""
  'Check that there are 12 characters
  If Len(chaine$) = 12 Then
    'And that these are many figures
    For i% = 1 To 12
      If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then
        i% = 0
        Exit For
      End If
    Next
    If i% = 13 Then
      'Calculation of the control key
      For i% = 2 To 12 Step 2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      checksum% = checksum% * 3
      For i% = 1 To 11 Step 2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
      'The first number is taken as is, the second comes from table A
      CodeBarre$ = Left$(chaine$, 1) & Chr$(65 + Val(Mid$(chaine$, 2, 1)))
      first% = Val(Left$(chaine$, 1))
      For i% = 3 To 7
        tableA = False
         Select Case i%
         Case 3
           Select Case first%
           Case 0 To 3
             tableA = True
           End Select
         Case 4
           Select Case first%
           Case 0, 4, 7, 8
             tableA = True
           End Select
         Case 5
           Select Case first%
           Case 0, 1, 4, 5, 9
             tableA = True
           End Select
         Case 6
           Select Case first%
           Case 0, 2, 5, 6, 7
             tableA = True
           End Select
         Case 7
           Select Case first%
           Case 0, 3, 6, 8, 9
             tableA = True
           End Select
         End Select
       If tableA Then
         CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
       Else
         CodeBarre$ = CodeBarre$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))
       End If
     Next
      CodeBarre$ = CodeBarre$ & "*"   'Adding central divider
      For i% = 8 To 13
        CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "+"   'Addition of end mark
      ean13$ = CodeBarre$
    End If
  End If
End Function
[/vba]

Автор - JohnnyTaylor
Дата добавления - 22.11.2023 в 13:00
JohnnyTaylor Дата: Среда, 22.11.2023, 19:05 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

2019
Собрал вот такой файл, может кому пригодится, но в идеале хочу исключить макрос и оставить создание кода формулой. Попробую разобраться сам, по аналогии с EAN-13. Но если есть готовый буду рад!

[vba]
Код
Public Function EAN_8$(chaine$)
  'V 1.0.0
  'Parametres : une chaine de 7 chiffres
  'Parameters : a 7 digits length string
  'Retour : * une chaine qui, affichee avec la police EAN13.TTF, donne le code barre
  '         * une chaine vide si parametre fourni incorrect
  'Return : * a string which give the bar code when it is dispayed with EAN13.TTF font
  '         * an empty string if the supplied parameter is no good
  Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
  EAN_8$ = ""
  'Verifier qu'il y a 7 caracteres
  'Check for 7 characters
  If Len(chaine$) = 7 Then
    'Et que ce sont bien des chiffres
    'And they are really digits
    For i% = 1 To 7
      If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then
        i% = 0
        Exit For
      End If
    Next
    If i% = 8 Then
      'Calcul de la cle de controle
      'Calculation of the checksum
      For i% = 7 To 1 Step -2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      checksum% = checksum% * 3
      For i% = 6 To 1 Step -2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
      'Les 4 premier chiffre viennent de la table A
      'The first 4 digits come from table A
      CodeBarre$ = ":"   'Ajout marque de debut / Add start mark
      For i% = 1 To 4
         CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "*"   'Ajout separateur central / Add middle separator
      For i% = 5 To 8
        CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "+"   'Ajout de la marque de fin / Add end mark
      EAN_8$ = CodeBarre$
    End If
  End If
End Function
Public Function EAN_13$(chaine$)
'V 1.0
'Parameters: a 12-digit string
'Return: * a chain which, displayed with the EAN13.TTF font, gives the barcode
'         * an empty string if parameter supplied incorrect
Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
EAN_13$ = ""
'Check that there are 12 characters
If Len(chaine$) = 12 Then
    'And that these are many figures
    For i% = 1 To 12
    If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then
        i% = 0
        Exit For
    End If
    Next
    If i% = 13 Then
    'Calculation of the control key
    For i% = 2 To 12 Step 2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
    Next
    checksum% = checksum% * 3
    For i% = 1 To 11 Step 2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
    Next
    chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
    'The first number is taken as is, the second comes from table A
    CodeBarre$ = Left$(chaine$, 1) & Chr$(65 + Val(Mid$(chaine$, 2, 1)))
    first% = Val(Left$(chaine$, 1))
    For i% = 3 To 7
        tableA = False
        Select Case i%
        Case 3
        Select Case first%
        Case 0 To 3
            tableA = True
        End Select
        Case 4
        Select Case first%
        Case 0, 4, 7, 8
            tableA = True
        End Select
        Case 5
        Select Case first%
        Case 0, 1, 4, 5, 9
            tableA = True
        End Select
        Case 6
        Select Case first%
        Case 0, 2, 5, 6, 7
            tableA = True
        End Select
        Case 7
        Select Case first%
        Case 0, 3, 6, 8, 9
            tableA = True
        End Select
        End Select
    If tableA Then
        CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
    Else
        CodeBarre$ = CodeBarre$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))
    End If
    Next
    CodeBarre$ = CodeBarre$ & "*"   'Adding central divider
    For i% = 8 To 13
        CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
    Next
    CodeBarre$ = CodeBarre$ & "+"   'Addition of end mark
    EAN_13$ = CodeBarre$
    End If
End If
End Function
[/vba]
К сообщению приложен файл: EAN.xlsm (18.6 Kb)
 
Ответить
СообщениеСобрал вот такой файл, может кому пригодится, но в идеале хочу исключить макрос и оставить создание кода формулой. Попробую разобраться сам, по аналогии с EAN-13. Но если есть готовый буду рад!

[vba]
Код
Public Function EAN_8$(chaine$)
  'V 1.0.0
  'Parametres : une chaine de 7 chiffres
  'Parameters : a 7 digits length string
  'Retour : * une chaine qui, affichee avec la police EAN13.TTF, donne le code barre
  '         * une chaine vide si parametre fourni incorrect
  'Return : * a string which give the bar code when it is dispayed with EAN13.TTF font
  '         * an empty string if the supplied parameter is no good
  Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
  EAN_8$ = ""
  'Verifier qu'il y a 7 caracteres
  'Check for 7 characters
  If Len(chaine$) = 7 Then
    'Et que ce sont bien des chiffres
    'And they are really digits
    For i% = 1 To 7
      If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then
        i% = 0
        Exit For
      End If
    Next
    If i% = 8 Then
      'Calcul de la cle de controle
      'Calculation of the checksum
      For i% = 7 To 1 Step -2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      checksum% = checksum% * 3
      For i% = 6 To 1 Step -2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
      Next
      chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
      'Les 4 premier chiffre viennent de la table A
      'The first 4 digits come from table A
      CodeBarre$ = ":"   'Ajout marque de debut / Add start mark
      For i% = 1 To 4
         CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "*"   'Ajout separateur central / Add middle separator
      For i% = 5 To 8
        CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
      Next
      CodeBarre$ = CodeBarre$ & "+"   'Ajout de la marque de fin / Add end mark
      EAN_8$ = CodeBarre$
    End If
  End If
End Function
Public Function EAN_13$(chaine$)
'V 1.0
'Parameters: a 12-digit string
'Return: * a chain which, displayed with the EAN13.TTF font, gives the barcode
'         * an empty string if parameter supplied incorrect
Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean
EAN_13$ = ""
'Check that there are 12 characters
If Len(chaine$) = 12 Then
    'And that these are many figures
    For i% = 1 To 12
    If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then
        i% = 0
        Exit For
    End If
    Next
    If i% = 13 Then
    'Calculation of the control key
    For i% = 2 To 12 Step 2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
    Next
    checksum% = checksum% * 3
    For i% = 1 To 11 Step 2
        checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
    Next
    chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
    'The first number is taken as is, the second comes from table A
    CodeBarre$ = Left$(chaine$, 1) & Chr$(65 + Val(Mid$(chaine$, 2, 1)))
    first% = Val(Left$(chaine$, 1))
    For i% = 3 To 7
        tableA = False
        Select Case i%
        Case 3
        Select Case first%
        Case 0 To 3
            tableA = True
        End Select
        Case 4
        Select Case first%
        Case 0, 4, 7, 8
            tableA = True
        End Select
        Case 5
        Select Case first%
        Case 0, 1, 4, 5, 9
            tableA = True
        End Select
        Case 6
        Select Case first%
        Case 0, 2, 5, 6, 7
            tableA = True
        End Select
        Case 7
        Select Case first%
        Case 0, 3, 6, 8, 9
            tableA = True
        End Select
        End Select
    If tableA Then
        CodeBarre$ = CodeBarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
    Else
        CodeBarre$ = CodeBarre$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))
    End If
    Next
    CodeBarre$ = CodeBarre$ & "*"   'Adding central divider
    For i% = 8 To 13
        CodeBarre$ = CodeBarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
    Next
    CodeBarre$ = CodeBarre$ & "+"   'Addition of end mark
    EAN_13$ = CodeBarre$
    End If
End If
End Function
[/vba]

Автор - JohnnyTaylor
Дата добавления - 22.11.2023 в 19:05
elovkov Дата: Четверг, 23.11.2023, 08:05 | Сообщение № 7
Группа: Друзья
Ранг: Обитатель
Сообщений: 385
Репутация: 51 ±
Замечаний: 0% ±

Excel 2013
И что это????

К сообщению приложен файл: 4384677.png (60.7 Kb)


Умное лицо это еще не признак ума. Все глупости на земле делаются именно с этим выражением лица
 
Ответить
СообщениеИ что это????


Автор - elovkov
Дата добавления - 23.11.2023 в 08:05
Nic70y Дата: Четверг, 23.11.2023, 08:27 | Сообщение № 8
Группа: Друзья
Ранг: Экселист
Сообщений: 8831
Репутация: 2300 ±
Замечаний: 0% ±

Excel 2010
elovkov, походу нужно установить соот. шрифт


ЮMoney 41001841029809
 
Ответить
Сообщениеelovkov, походу нужно установить соот. шрифт

Автор - Nic70y
Дата добавления - 23.11.2023 в 08:27
DrMini Дата: Четверг, 23.11.2023, 08:33 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 1734
Репутация: 236 ±
Замечаний: 0% ±

Excel LTSC 2024 RUS
установить соот. шрифт

тогда всё будет выглядеть иначе.
К сообщению приложен файл: 1736794.jpg (18.1 Kb)
 
Ответить
Сообщение
установить соот. шрифт

тогда всё будет выглядеть иначе.

Автор - DrMini
Дата добавления - 23.11.2023 в 08:33
JohnnyTaylor Дата: Четверг, 23.11.2023, 23:03 | Сообщение № 10
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

2019
elovkov, что бы корректно работало, нужно скачать и установить специальный шрифт, например отсюда:

Скачать шрифт EAN-13
 
Ответить
Сообщениеelovkov, что бы корректно работало, нужно скачать и установить специальный шрифт, например отсюда:

Скачать шрифт EAN-13

Автор - JohnnyTaylor
Дата добавления - 23.11.2023 в 23:03
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!