Se precisar de outro exemplo veja este.

 

Public Function EAN13(DataToEncode As String) As String
    DataToPrint = ""
    OnlyCorrectData = ""
    'Check to make sure data is numeric and remove dashes, etc.
    StringLength = Len(DataToEncode)
    For I = 1 To StringLength
         'Add all numbers to OnlyCorrectData string
         '2006.2 BDA modified the next 3 lines for compatibility with different office versions
         'If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
         CurrentCharNum = AscW(Mid(DataToEncode, I, 1))
         If CurrentCharNum > 47 And CurrentCharNum < 58 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
    Next I
    '2006.2 BDA added the next line for general compatibility
    StringLength = Len(OnlyCorrectData)
    If StringLength < 12 Then OnlyCorrectData = "0000000000000"
    If StringLength = 16 Then OnlyCorrectData = "0000000000000"
    If StringLength = 13 Then OnlyCorrectData = Mid(OnlyCorrectData, 1, 12)
    If StringLength = 15 Then OnlyCorrectData = (Mid(OnlyCorrectData, 1, 12) & Mid(OnlyCorrectData, 14, 2))
    If StringLength > 17 Then OnlyCorrectData = (Mid(OnlyCorrectData, 1, 12) & Mid(OnlyCorrectData, 14, 5))
    Dim EAN2AddOn As String
    Dim EAN5AddOn As String
    EAN2AddOn = ""
    EAN5AddOn = ""
    '2006.2 BDA added the next line for general compatibility
    StringLength = Len(OnlyCorrectData)
    If StringLength = 17 Then EAN5AddOn = Mid(OnlyCorrectData, 13, 5)
    If StringLength = 14 Then EAN2AddOn = Mid(OnlyCorrectData, 13, 2)
    'Remove digit number from add-ons and check digit
    DataToEncode = Mid(OnlyCorrectData, 1, 12)
    'Calculate Check Digit
    Factor = 3
    WeightedTotal = 0
    For I = Len(DataToEncode) To 1 Step -1
        'Get the value of each number starting at the end
        CurrentCharNum = Mid(DataToEncode, I, 1)
        'Multiply by the weighting factor which is 3,1,3,1...
        'and add the sum together
        WeightedTotal = WeightedTotal + CurrentCharNum * Factor
        'Change factor for next calculation
        Factor = 4 - Factor
    Next I
    'Find the CheckDigit by finding the number + WeightedTotal that = a multiple of 10
    'Divide by 10, get the remainder and subtract from 10
    I = (WeightedTotal Mod 10)
    If I <> 0 Then
        CheckDigit = (10 - I)
    Else
        CheckDigit = 0
    End If
    'Encode the leading digit into the left half of the EAN-13 symbol
    'by using variable parity between character sets A and B
    LeadingDigit = Mid(DataToEncode, 1, 1)
    Select Case LeadingDigit
    Case 0
    Encoding = "AAAAAACCCCCC"
    Case 1
    Encoding = "AABABBCCCCCC"
    Case 2
    Encoding = "AABBABCCCCCC"
    Case 3
    Encoding = "AABBBACCCCCC"
    Case 4
    Encoding = "ABAABBCCCCCC"
    Case 5
    Encoding = "ABBAABCCCCCC"
    Case 6
    Encoding = "ABBBAACCCCCC"
    Case 7
    Encoding = "ABABABCCCCCC"
    Case 8
    Encoding = "ABABBACCCCCC"
    Case 9
    Encoding = "ABBABACCCCCC"
    End Select
    'Add the check digit to the end of the barcode & remove the leading digit
    DataToEncode = Mid(DataToEncode, 2, 11) & CheckDigit
    'Determine character to print for proper barcoding
    StringLength = Len(DataToEncode)
    For I = 1 To StringLength
    'Get the ASCII value of each number excluding the first number because
    'it is encoded with variable parity
    CurrentCharNum = AscW(Mid(DataToEncode, I, 1))
    CurrentEncoding = Mid(Encoding, I, 1)
    'Print different barcodes according to the location of the CurrentChar and CurrentEncoding
    Select Case CurrentEncoding
    Case "A"
         DataToPrint = DataToPrint & ChrW(CurrentCharNum)
    Case "B"
         DataToPrint = DataToPrint & ChrW(CurrentCharNum + 17)
    Case "C"
         DataToPrint = DataToPrint & ChrW(CurrentCharNum + 27)
    End Select
    'Add in the 1st character along with guard patterns
    Select Case I
    Case 1
        'For the LeadingDigit, print the human readable character,
        'the normal guard pattern, and then the rest of the barcode
        If LeadingDigit > 4 Then DataToPrint = ChrW((LeadingDigit + 48) + 64) & "(" & DataToPrint
        If LeadingDigit < 5 Then DataToPrint = ChrW((LeadingDigit + 48) + 37) & "(" & DataToPrint
    Case 6
        'Print the center guard pattern after the 6th character
        DataToPrint = DataToPrint & "*"
    Case 12
        'For the last character (12), print the the normal guard pattern after the barcode
        DataToPrint = DataToPrint & "("
    End Select
    Next I
    'Process add-ons if they exist
    If Len(EAN2AddOn) = 2 Then DataToPrint = DataToPrint & " " & ProcessEAN2AddOn(EAN2AddOn)
    If Len(EAN5AddOn) = 5 Then DataToPrint = DataToPrint & " " & ProcessEAN5AddOn(EAN5AddOn)
    'Return PrintableString
    EAN13 = DataToPrint
End Function

 

 

Abraços,