' UPCTools 03jan07 jwhiting ' Copyright 2007 Azalea Software, Inc. All rights reserved. www.azalea.com ' The input, UPC_E_number, is either the 6 digits from an existing UPC version E symbol, ' or a 10-digit product number with an assumed first digit of "0". ' Format the output, Azalea_UPC_E, using an Azalea Software, Inc. bar code font. ' Note that this routine requires the AzaleaEvenBar and AzaleaOddBar functions. Dim manitem As String ' combo Dim final As String ' output before check digit and start bar Dim temp As String Dim CheckDigit As Integer ' check digit itself ' Is this 6-digit or a 10-digit input? UPC_E_number = Trim(UPC_E_number) If Len(UPC_E_number) = 6 Then ' we're decompressing a 6 digit ver E input... Select Case Val(Right(Trim(UPC_E_number), 1)) Case 0 manitem = Left(UPC_E_number, 2) + "00000" + Mid(UPC_E_number, 3, 3) Case 1 manitem = Left(UPC_E_number, 2) + "10000" + Mid(UPC_E_number, 3, 3) Case 2 manitem = Left(UPC_E_number, 2) + "20000" + Mid(UPC_E_number, 3, 3) Case 3 manitem = Left(UPC_E_number, 3) + "00000" + Mid(UPC_E_number, 4, 2) Case 4 manitem = Left(UPC_E_number, 4) + "00000" + Mid(UPC_E_number, 5, 1) Case 5 To 9 manitem = Left(UPC_E_number, 5) + "0000" + Right(UPC_E_number, 1) End Select Else manitem = UPC_E_number End If ' put final together from manufacturer & item according to Ver E rules If Mid(manitem, 5, 1) <> "0" Then final = Left(manitem, 5) + Right(manitem, 1) ElseIf Mid(manitem, 5, 1) = "0" And Mid(manitem, 4, 1) <> "0" Then final = Left(manitem, 4) + Right(manitem, 1) + "4" ElseIf Mid(manitem, 4, 2) = "00" And Mid(manitem, 3, 1) > "2" Then final = Left(manitem, 3) + Right(manitem, 2) + "3" ElseIf Mid(manitem, 4, 2) = "00" And Mid(manitem, 3, 1) < "3" Then final = Left(manitem, 2) + Right(manitem, 3) + Mid(manitem, 3, 1) End If ' now do the check digit CheckDigit = 3 * (Val(Mid(manitem, 2, 1)) + Val(Mid(manitem, 4, 1)) + Val(Mid(manitem, 6, 1)) + Val(Mid(manitem, 8, 1)) + Val(Mid(manitem, 10, 1))) CheckDigit = CheckDigit + Val(Mid(manitem, 1, 1)) + Val(Mid(manitem, 3, 1)) + Val(Mid(manitem, 5, 1)) + Val(Mid(manitem, 7, 1)) + Val(Mid(manitem, 9, 1)) CheckDigit = 10 - (CheckDigit Mod 10) If CheckDigit = 10 Then CheckDigit = 0 ' set up Azalea_UPC_E as 0 numSys human readable & L guard bar ' even for left(final,1) temp = "U|x" + AzaleaEvenBar(Left(final, 1)) ' parity options for mid(final, 2, 4) Select Case CheckDigit Case "0" ' EEOOO temp = temp + AzaleaEvenBar(Mid(final, 2, 1)) temp = temp + AzaleaEvenBar(Mid(final, 3, 1)) temp = temp + AzaleaOddBar(Mid(final, 4, 1)) temp = temp + AzaleaOddBar(Mid(final, 5, 1)) temp = temp + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp + "wU" Case "1" ' EOEOO temp = temp + AzaleaEvenBar(Mid(final, 2, 1)) temp = temp + AzaleaOddBar(Mid(final, 3, 1)) temp = temp + AzaleaEvenBar(Mid(final, 4, 1)) temp = temp + AzaleaOddBar(Mid(final, 5, 1)) temp = temp + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp + "w[" Case "2" ' EOOEO temp = temp + AzaleaEvenBar(Mid(final, 2, 1)) temp = temp + AzaleaOddBar(Mid(final, 3, 1)) temp = temp + AzaleaOddBar(Mid(final, 4, 1)) temp = temp + AzaleaEvenBar(Mid(final, 5, 1)) temp = temp + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp + "wV" Case "3" ' EOOOE temp = temp + AzaleaEvenBar(Mid(final, 2, 1)) temp = temp + AzaleaOddBar(Mid(final, 3, 1)) temp = temp + AzaleaOddBar(Mid(final, 4, 1)) temp = temp + AzaleaOddBar(Mid(final, 5, 1)) temp = temp + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp + "wW" Case "4" ' OEEOO temp = temp + AzaleaOddBar(Mid(final, 2, 1)) temp = temp + AzaleaEvenBar(Mid(final, 3, 1)) temp = temp + AzaleaEvenBar(Mid(final, 4, 1)) temp = temp + AzaleaOddBar(Mid(final, 5, 1)) temp = temp + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp + "wX" Case "5" ' OOEEO temp = temp + AzaleaOddBar(Mid(final, 2, 1)) temp = temp + AzaleaOddBar(Mid(final, 3, 1)) temp = temp + AzaleaEvenBar(Mid(final, 4, 1)) temp = temp + AzaleaEvenBar(Mid(final, 5, 1)) temp = temp + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp + "wY" Case "6" ' OOOEE temp = temp + AzaleaOddBar(Mid(final, 2, 1)) temp = temp + AzaleaOddBar(Mid(final, 3, 1)) temp = temp + AzaleaOddBar(Mid(final, 4, 1)) temp = temp + AzaleaEvenBar(Mid(final, 5, 1)) temp = temp + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp + "wZ" Case "7" ' OEOEO temp = temp + AzaleaOddBar(Mid(final, 2, 1)) temp = temp + AzaleaEvenBar(Mid(final, 3, 1)) temp = temp + AzaleaOddBar(Mid(final, 4, 1)) temp = temp + AzaleaEvenBar(Mid(final, 5, 1)) temp = temp + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp + "wu" Case "8" ' OEOOE temp = temp + AzaleaOddBar(Mid(final, 2, 1)) temp = temp + AzaleaEvenBar(Mid(final, 3, 1)) temp = temp + AzaleaOddBar(Mid(final, 4, 1)) temp = temp + AzaleaOddBar(Mid(final, 5, 1)) temp = temp + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp + "w\" Case "9" ' OOEOE temp = temp + AzaleaOddBar(Mid(final, 2, 1)) temp = temp + AzaleaOddBar(Mid(final, 3, 1)) temp = temp + AzaleaEvenBar(Mid(final, 4, 1)) temp = temp + AzaleaOddBar(Mid(final, 5, 1)) temp = temp + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp + "w]" End Select ' The output, Azalea_UPC_E, is formatted using one of Azalea Software's UPC fonts. ' For example, B1=Azalea_UPC_E(A1) ' Or put another way, yourContainer.text=Azalea_UPC_E(yourInputString) End Function Public Function AzaleaOddBar(ByVal the As String) As String ' UPCTools 03jan07 jwhiting ' Copyright 2007 Azalea Software, Inc. All rights reserved. www.azalea.com AzaleaOddBar = Chr(65 + (Val(the))) End Function Public Function AzaleaEvenBar(ByVal the As String) As String ' UPCTools 03jan07 jwhiting ' Copyright 2007 Azalea Software, Inc. All rights reserved. www.azalea.com AzaleaEvenBar = Chr(75 + Val(the)) End Function