Attribute VB_Name = "Module1"
Option Explicit
 
Public Function AzaleaSoftware_EAN13(ByVal EAN As String) As String
' UPCTools 01oct08 gacadogan
' Copyright 2007 Azalea Software, Inc. All rights reserved. www.azalea.com
  ' The input, EAN, is a 12-digit number.
  ' Note that this routine requires the EvenBar & OddBar functions too.
 
  Dim checkDigitSubtotal As Integer     ' throw-away variable
  Dim checkDigit As String              ' check digit
  Dim temp As String                    ' placeholder variable
  
  ' do the check digit
  checkDigitSubtotal = 3 * (Val(Mid(EAN, 2, 1)) + Val(Mid(EAN, 4, 1)) + Val(Mid(EAN, 6, 1)) + Val(Mid(EAN, 8, 1)) + Val(Mid(EAN, 10, 1)) + Val(Right(EAN, 1)))
  checkDigitSubtotal = checkDigitSubtotal + Val(Left(EAN, 1)) + Val(Mid(EAN, 3, 1)) + Val(Mid(EAN, 5, 1)) + Val(Mid(EAN, 7, 1)) + Val(Mid(EAN, 9, 1)) + Val(Mid(EAN, 11, 1))
  checkDigit = Right(Str(300 - checkDigitSubtotal), 1)
   
  ' AzaleaSoftware_EAN13= 1st character's human-readable, L guard bar & odd parity of 1st digit
  temp = Chr(194 + CInt(Left(EAN, 1))) & "x" & OddBar(Mid(EAN, 2, 1))
   
  ' remainder of left half of symbol's parity is based on 1st digit
  Select Case Left(EAN, 1)
    Case "0"  ' OOOOO
      temp = temp + OddBar(Mid(EAN, 3, 1))
      temp = temp + OddBar(Mid(EAN, 4, 1))
      temp = temp + OddBar(Mid(EAN, 5, 1))
      temp = temp + OddBar(Mid(EAN, 6, 1))
      temp = temp + OddBar(Mid(EAN, 7, 1))
    Case "1"  ' OEOEE
      temp = temp + OddBar(Mid(EAN, 3, 1))
      temp = temp + EvenBar(Mid(EAN, 4, 1))
      temp = temp + OddBar(Mid(EAN, 5, 1))
      temp = temp + EvenBar(Mid(EAN, 6, 1))
      temp = temp + EvenBar(Mid(EAN, 7, 1))
    Case "2"  ' OEEOE
      temp = temp + OddBar(Mid(EAN, 3, 1))
      temp = temp + EvenBar(Mid(EAN, 4, 1))
      temp = temp + EvenBar(Mid(EAN, 5, 1))
      temp = temp + OddBar(Mid(EAN, 6, 1))
      temp = temp + EvenBar(Mid(EAN, 7, 1))
    Case "3"  ' OEEEO
      temp = temp + OddBar(Mid(EAN, 3, 1))
      temp = temp + EvenBar(Mid(EAN, 4, 1))
      temp = temp + EvenBar(Mid(EAN, 5, 1))
      temp = temp + EvenBar(Mid(EAN, 6, 1))
      temp = temp + OddBar(Mid(EAN, 7, 1))
    Case "4"  ' EOOEE
      temp = temp + EvenBar(Mid(EAN, 3, 1))
      temp = temp + OddBar(Mid(EAN, 4, 1))
      temp = temp + OddBar(Mid(EAN, 5, 1))
      temp = temp + EvenBar(Mid(EAN, 6, 1))
      temp = temp + EvenBar(Mid(EAN, 7, 1))
    Case "5"  ' EEOOE
      temp = temp + EvenBar(Mid(EAN, 3, 1))
      temp = temp + EvenBar(Mid(EAN, 4, 1))
      temp = temp + OddBar(Mid(EAN, 5, 1))
      temp = temp + OddBar(Mid(EAN, 6, 1))
      temp = temp + EvenBar(Mid(EAN, 7, 1))
    Case "6"  ' EEEOO
      temp = temp + EvenBar(Mid(EAN, 3, 1))
      temp = temp + EvenBar(Mid(EAN, 4, 1))
      temp = temp + EvenBar(Mid(EAN, 5, 1))
      temp = temp + OddBar(Mid(EAN, 6, 1))
      temp = temp + OddBar(Mid(EAN, 7, 1))
    Case "7"  ' EOEOE
      temp = temp + EvenBar(Mid(EAN, 3, 1))
      temp = temp + OddBar(Mid(EAN, 4, 1))
      temp = temp + EvenBar(Mid(EAN, 5, 1))
      temp = temp + OddBar(Mid(EAN, 6, 1))
      temp = temp + EvenBar(Mid(EAN, 7, 1))
    Case "8"  ' EOEEO
      temp = temp + EvenBar(Mid(EAN, 3, 1))
      temp = temp + OddBar(Mid(EAN, 4, 1))
      temp = temp + EvenBar(Mid(EAN, 5, 1))
      temp = temp + EvenBar(Mid(EAN, 6, 1))
      temp = temp + OddBar(Mid(EAN, 7, 1))
    Case "9"  ' EEOEO
      temp = temp + EvenBar(Mid(EAN, 3, 1))
      temp = temp + EvenBar(Mid(EAN, 4, 1))
      temp = temp + OddBar(Mid(EAN, 5, 1))
      temp = temp + EvenBar(Mid(EAN, 6, 1))
      temp = temp + OddBar(Mid(EAN, 7, 1))
  End Select
 
  ' center guard bar & the build right half of symbol using set C (0-9)
  AzaleaSoftware_EAN13 = temp + "y" + Mid(EAN, 8, 5) + checkDigit + "z"
 
  ' Format the output, AzaleaSoftware_EAN13, using an Azalea Software, Inc. bar code font.
 
End Function
 
Private Static Function OddBar(ByVal theString As String) As String
' UPCTools 03jan07 jwhiting
' Copyright 2007 Azalea Software, Inc. All rights reserved. www.azalea.com
  OddBar = Chr(65 + (Val(theString)))
End Function
 
Private Static Function EvenBar(ByVal theString As String) As String
' UPCTools 03jan07 jwhiting
' Copyright 2007 Azalea Software, Inc. All rights reserved. www.azalea.com
  EvenBar = Chr(75 + Val(theString))
End Function