Creating UPC version E barcodes in Excel Azalea_UPC_E Copyright 2009 Azalea Software, Inc. All rights reserved. www.azalea.com The macro in this spreadsheet creates UPC version E barcodes when used with Azalea Software's UPCTools font package. Because this spreadsheet is built around a macro, you *must* enable macros for this spreadsheet to work! The .xls file is for Excel 2003 and the .xlsm is for Excel 2007. An alternative is to use a User Defined Function as an .xla (Excel 2003) or .xlam (Excel 2007). The macro accepts 7-, 8-, or 11--digit input as a string. 7 digits is zero-suppressed string from an existing UPC version E symbol. 8 digits is zero-suppressed string from an existing UPC version E symbol with the calculated check digit. 11 digit is the company prefix + unique product number used to create a version E symbol. The macro calculates the check digit if necessary and maps the output into the UPCTools character set. Format the returned value in a UPCTools font and a barcode will be displayed and printed. Press ALT-F11 to view the macro in the Visual Basic Editor. To add the macro to your own spreadsheet: Tools/Macro/Visual Basic Editor Insert/Module Paste in the macro code Close the Visual Basic Editor When you return to your spreadsheet, a new User Defined function is available: Azalea_UPC_E UPCTools prints UPC, ISBN-13, EAN, JAN, and ISSN barcodes. Available for Windows, OS X, Linux/UNIX, et al. Free sample code and free tech support. Buy online and download immediately. www.azalea.com/UPC Function Azalea_UPC_E(ByVal UPCnumber As String) As String ' UPCTools 16mar09 jwhiting ' Copyright 2009 Azalea Software, Inc. All rights reserved. www.azalea.com ' Creating a UPC version E in Excel 2003 ' The input, UPCnumber, 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". ' If your input is 11 digits, strip the leading "0": UPCnumber = Left(UPCnumber, 10) ' Note: this routine requires the AzaleaEvenBar and AzaleaOddBar functions too. UPC_E_number = Trim(UPCnumber) Dim temp1 As String ' a temporary placeholder Dim temp2 As String ' another temporary placeholder Dim final As String ' output without the check digit or start bar Dim CheckDigit As Integer ' the check digit itself ' Is the input a 6-digit string or a 10-digit string? If Len(UPCnumber) = 6 Then ' OK, we've got a 6-digit input string from an existing version E symbol. Select Case Val(Right(Trim(UPCnumber), 1)) Case 0 temp1 = Left(UPCnumber, 2) + "00000" + Mid(UPCnumber, 3, 3) Case 1 temp1 = Left(UPCnumber, 2) + "10000" + Mid(UPCnumber, 3, 3) Case 2 temp1 = Left(UPCnumber, 2) + "20000" + Mid(UPCnumber, 3, 3) Case 3 temp1 = Left(UPCnumber, 3) + "00000" + Mid(UPCnumber, 4, 2) Case 4 temp1 = Left(UPCnumber, 4) + "00000" + Mid(UPCnumber, 5, 1) Case 5 To 9 temp1 = Left(UPCnumber, 5) + "0000" + Right(UPCnumber, 1) End Select Else ' The input is already 10 digits long. temp1 = UPCnumber End If ' Let's assemble final from manufacturer number and item number according to version E rules. (Arcane terms I know.) If Mid(temp1, 5, 1) <> "0" Then final = Left(temp1, 5) + Right(temp1, 1) ElseIf Mid(temp1, 5, 1) = "0" And Mid(temp1, 4, 1) <> "0" Then final = Left(temp1, 4) + Right(temp1, 1) + "4" ElseIf Mid(temp1, 4, 2) = "00" And Mid(temp1, 3, 1) > "2" Then final = Left(temp1, 3) + Right(temp1, 2) + "3" ElseIf Mid(temp1, 4, 2) = "00" And Mid(temp1, 3, 1) < "3" Then final = Left(temp1, 2) + Right(temp1, 3) + Mid(temp1, 3, 1) End If ' Time to do the 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. CheckDigit = 3 * (Val(Mid(temp1, 2, 1)) + Val(Mid(temp1, 4, 1)) + Val(Mid(temp1, 6, 1)) + Val(Mid(temp1, 8, 1)) + Val(Mid(temp1, 10, 1))) CheckDigit = CheckDigit + Val(Mid(temp1, 1, 1)) + Val(Mid(temp1, 3, 1)) + Val(Mid(temp1, 5, 1)) + Val(Mid(temp1, 7, 1)) + Val(Mid(temp1, 9, 1)) CheckDigit = 10 - (CheckDigit Mod 10) If CheckDigit = 10 Then CheckDigit = 0 ' Assemble output string with the assumed first digit on "0" and the left guard bars. ' The first number, left(final,1)), always has even parity temp2 = "U|x" + AzaleaEvenBar(Left(final, 1)) ' The variuos parity options for mid(final, 2, 4) depend on the check digit value. Select Case CheckDigit Case "0" ' EEOOO temp2 = temp2 + AzaleaEvenBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wU" Case "1" ' EOEOO temp2 = temp2 + AzaleaEvenBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "w[" Case "2" ' EOOEO temp2 = temp2 + AzaleaEvenBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wV" Case "3" ' EOOOE temp2 = temp2 + AzaleaEvenBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wW" Case "4" ' OEEOO temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wX" Case "5" ' OOEEO temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wY" Case "6" ' OOOEE temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wZ" Case "7" ' OEOEO temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "wu" Case "8" ' OEOOE temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "w\" Case "9" ' OOEOE temp2 = temp2 + AzaleaOddBar(Mid(final, 2, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 3, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 4, 1)) temp2 = temp2 + AzaleaOddBar(Mid(final, 5, 1)) temp2 = temp2 + AzaleaEvenBar(Mid(final, 6, 1)) Azalea_UPC_E = temp2 + "w]" End Select ' The output, Azalea_UPC_E, needs to be formatted in one of Azalea Software's UPC fonts. ' We recommend UPCTallThin at 73 points. ' Excel: 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 16mar09 jwhiting ' Copyright 2009 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 16mar09 jwhiting ' Copyright 2009 Azalea Software, Inc. All rights reserved. www.azalea.com AzaleaEvenBar = Chr(75 + Val(the)) End Function