MrShindk2005хотелось обойтись без ActiveX
Посмотрите
здесь , там есть секция для UPC баркодов со шрифтами прочим необходимым.
Спасибо! Кажется это то, что надо.
Вот сам код, в конце есть рекомендация использовать шрифт UPCTallThin.
На их сайте есть пример - рабочая база, в ней используется шрифт UPCHalfNarrow.
Ни тот, ни другой шрифты я пока найти не могу.
А со шрифтами, которые есть у меня (UPC-A.ttf) не получается.
Не понимаю, есть стандартный алгоритм преобразования числового кода в ASCII, который здесь и реализован.
Почему же он тогда работает только с определенным шрифтом?
Понять, что здесь изменить мозгов не хватает.
Function Azalea_UPC_A(ByVal UPCnumber As String) As String
' UPCTools 16may12 jwhiting
' Copyright 2012 Azalea Software, Inc. All rights reserved. www.azalea.com
' Creating a UPC version A in Excel
' Your input, UPCnumber, is a string consisting of an 11-, 12-, or 14-digit number.
' company prefix + product ID, company prefix + product ID + check digit, or GTIN (Global Trade Identification Number)
Dim checkDigitSubtotal As Integer ' a check digit throwaway
Dim i As Integer ' our loop counter
Dim checkDigit As String ' the check digit itself
Dim temp As String ' a temporary placeholder
' Possible valid input includes 11-digits (no check digit), 12-digits (with check digit), or 14-digits (GTIN).
Select Case Len(UPCnumber)
Case 11
' We're going to do the UPC check digit calculation because the input doesn't have it.
Case 12
' Let's strip your check digit and calculate it from scratch.
UPCnumber = Left(UPCnumber, 11)
Case 14
' GTIN input, but we're going to strip the leading 2 and the last characters to extract the 11-digit input without check digit.
UPCnumber = Mid(UPCnumber, 3, 11)
Case Else
' Your error handling goes here...
End Select
' Build the output string beginning with the first human-readable digit, a spacer, the left guard bars, and the bars for the first character.
Select Case Left(UPCnumber, 1)
Case "0"
temp = "U|xa"
Case "1"
temp = "[|xb"
Case "2"
temp = "V|xc"
Case "3"
temp = "W|xd"
Case "4"
temp = "X|xe"
Case "5"
temp = "Y|xf"
Case "6"
temp = "Z|xg"
Case "7"
temp = "u|xh"
Case "8"
temp = "\|xi"
Case "9"
temp = "]|xj"
End Select
' Continue with the 5 numbers in the left notch.
For i = 2 To 6 Step 1
temp = temp + Chr(65 + (Val(Mid(UPCnumber, i, 1))))
Next i
' Now we need to do the UPC A check digit calculation.
' Add up the numbers in the odd positions left to right. Multiple the result by 3.
' Add up the numbers in the even positions. Now add the first subtotal to the second.
' The UPC barcode check digit is the single digit number makes the total a multiple of 10.
checkDigitSubtotal = (Val(Left(UPCnumber, 1))) + (Val(Mid(UPCnumber, 3, 1))) + (Val(Mid(UPCnumber, 5, 1))) + (Val(Mid(UPCnumber, 7, 1))) + (Val(Mid(UPCnumber, 9, 1))) + (Val(Right(UPCnumber, 1)))
checkDigitSubtotal = (3 * checkDigitSubtotal) + (Val(Mid(UPCnumber, 2, 1))) + (Val(Mid(UPCnumber, 4, 1))) + (Val(Mid(UPCnumber, 6, 1))) + (Val(Mid(UPCnumber, 8, 1))) + (Val(Mid(UPCnumber, 10, 1)))
checkDigit = Right(Str(300 - checkDigitSubtotal), 1)
' Continue to build the output string by adding the center guard bars, 5 digits in the right notch, check digit and right guard bars.
temp = temp + "y" + Right(UPCnumber, 5) + Chr(107 + (Val(checkDigit))) + "z"
' Lastly let's add the human readable for the check digit in the lower right corner.
Select Case checkDigit
Case "0"
Azalea_UPC_A = temp + "U"
Case "1"
Azalea_UPC_A = temp + "["
Case "2"
Azalea_UPC_A = temp + "V"
Case "3"
Azalea_UPC_A = temp + "W"
Case "4"
Azalea_UPC_A = temp + "X"
Case "5"
Azalea_UPC_A = temp + "Y"
Case "6"
Azalea_UPC_A = temp + "Z"
Case "7"
Azalea_UPC_A = temp + "u"
Case "8"
Azalea_UPC_A = temp + "\"
Case "9"
Azalea_UPC_A = temp + "]"
End Select
' The output, Azalea_UPC_A, needs to be formatted in one of Azalea Software's UPC fonts.
' We recommend UPCTallThin at 73 points.
' Excel: B1=Azalea_UPC_A(A1)
' Or put another way, yourContainer.text=Azalea_UPC_A(yourInputString)
End Function
