Pour générer une image (jpg ou png) correspondant à un code barre utilisez le lien www.barcodesinc.com/generator

Prendre l'ensemble :

Public Function IsGoodNuart(ByVal sNUART As String) As Boolean
Dim sClef As String
    If Len(sNUART) <> 7 Then GoTo FinVerifNon
    sClef = Mid$(sNUART, 7, 1)
    If ClefNUART(Left$(sNUART, 6)) <> sClef Then GoTo FinVerifNon
    IsGoodNuart = True
    Exit Function
FinVerifNon:
    IsGoodNuart = False
End Function
 
Public Function IsGoodNucli(ByVal sNucli As String) As Boolean
Dim sClef As String
    If Len(sNucli) <> 6 Then GoTo FinVerifNon
    sClef = Mid$(sNucli, 6, 1)
    If ClefNUCLI(Left$(sNucli, 5)) <> sClef Then GoTo FinVerifNon
    IsGoodNucli = True
    Exit Function
FinVerifNon:
    IsGoodNucli = False
End Function
 
'Exemple Formaté : 2-216-01674-8 = 10 chiffres
Public Function IsGoodISBN(ByVal sISBN As String) As Boolean
Dim sClef As String
    sISBN = FiltreCar(sISBN, "-")
    If Len(sISBN) <> 10 Then GoTo FinVerifNon
    sClef = Mid$(sISBN, 10, 1)
    If ClefISBN(Left$(sISBN, 9)) <> sClef Then GoTo FinVerifNon
    IsGoodISBN = True
    Exit Function
FinVerifNon:
    IsGoodISBN = False
End Function
 
'Exemple Formaté : 978 2 216 01674 7 = 13 chiffres
Public Function IsGoodEAN13(ByVal sEAN13 As String) As Boolean
Dim sClef As String
    sEAN13 = FiltreCar(sEAN13, " ")
    If Len(sEAN13) <> 13 Then GoTo FinVerifNon
    sClef = Mid$(sEAN13, 13, 1)
    If ClefEAN13(Left$(sEAN13, 12)) <> sClef Then GoTo FinVerifNon
    IsGoodEAN13 = True
    Exit Function
FinVerifNon:
    IsGoodEAN13 = False
End Function
 
'Calcul de la clef sur les 6 premiers Numéros sur 7
Public Function ClefNUART(ByVal sNo As String) As String
Dim i As Integer, iTest As Integer, iTC As Integer
Dim iNo As Integer, iNo2 As Integer
    For i = Len(sNo) To 1 Step -1
  iTest = iTest + 1
  iNo = Mid(sNo, i, 1)
  'Algo de Luhn (CB et Siret)
  'If iTest Mod 2 <> 0 Then
  'On additionne les chiffres de position impaire : No 1, 3, 5, etc
  'On double les chiffres de position paires : No 2, 4, 6, etc
  'NUART = Algo de Luhn inversé
  If iTest Mod 2 = 0 Then
'On additionne les chiffres de position paires : No 2, 4, 6, etc
iTC = iTC + iNo
  Else
'On double les chiffres de position impaire : No 1, 3, 5, etc
iNo2 = iNo * 2
If iNo2 > 9 Then
    'Si Double > 9 on soustrait 9
    iTC = iTC + iNo2 - 9
Else
    'Si Double <= 9 on additionne
    iTC = iTC + iNo2
End If
  End If
    Next  
    If iTC Mod 10 = 0 Then
  ClefNUART = 0
    Else
  ClefNUART = 10 - (iTC Mod 10)
    End If
End Function
 
Public Function ClefISBN(ByVal sISBN As String) As String
Dim iValAlone As Integer, lValTotal As Long
Dim iCompteur As Integer, iDecompte As Integer
Dim iClef As Integer, sClef As String
    '====================================CALCUL DE LA CLEF ISBN
    'Somme de la multiplication de chaque chiffre par 10 9 8 ...
    lValTotal = 0
    iCompteur = 1    
    For iDecompte = 10 To 2 Step -1
  iValAlone = Val(Mid$(sISBN, iCompteur, 1))
  lValTotal = lValTotal + (iValAlone * iDecompte)
  iCompteur = iCompteur + 1
    Next    
    iClef = lValTotal Mod 11
    If iClef = 0 Then sClef = "0"
    If iClef = 1 Then sClef = "X"
    If iClef >= 2 Then sClef = CStr(11 - iClef)
    ClefISBN = sClef
End Function
 
'Calcul de la clef sur les 5 premiers Numéros sur 6
Public Function ClefNUCLI(ByVal sNo As String) As String
Dim i As Integer, iTest As Integer, iTC As Integer
Dim iNo As Integer, iNo2 As Integer
    For i = Len(sNo) To 1 Step -1
  iTest = iTest + 1
  iNo = Mid(sNo, i, 1)
  'Algo de Luhn (CB et Siret)
  'If iTest Mod 2 <> 0 Then
  'On additionne les chiffres de position impaire : No 1, 3, 5, etc
  'On double les chiffres de position paires : No 2, 4, 6, etc
  'NUART = Algo de Luhn inversé
  If iTest Mod 2 = 0 Then
'On additionne les chiffres de position paires : No 2, 4, 6, etc
iTC = iTC + iNo
  Else
'On double les chiffres de position impaire : No 1, 3, 5, etc
iNo2 = iNo * 2
If iNo2 > 9 Then
    'Si Double > 9 on soustrait 9
    iTC = iTC + iNo2 - 9
Else
    'Si Double <= 9 on additionne
    iTC = iTC + iNo2
End If
  End If
    Next
    If iTC Mod 10 = 0 Then
  ClefNUCLI = 0
    Else
  ClefNUCLI = 10 - (iTC Mod 10)
    End If
End Function
 
Public Function EAN13_ISBN(ByVal EAN13 As String) As String
    EAN13 = FiltreCar(EAN13, " ")
    'Enlever l'identifiant Bookland
    '978 = Livres  Francophones et 977 = périodiques Francophones
    EAN13 = Mid$(EAN13, 4, Len(EAN13))
    'Enlever la clef de controle
    EAN13 = Mid$(EAN13, 1, Len(EAN13) - 1)
    EAN13 = EAN13 & ClefISBN(EAN13)
    EAN13_ISBN = EAN13
End Function
 
'====================================FORMATAGE ISBN
Public Function FormateISBN(ByVal sISBN As String) As String
Dim sClef As String
Dim iGroupe As Integer, iEditeur As Integer, iTitre As Integer
Dim sGroupe As String, sEditeur As String, sTitre As String
Dim L As String
Dim Tmp As String
    If Len(sISBN) <> 10 Then
  FormateISBN = ""
  Exit Function
    End If
    'Segment du goupe
    If Val(Left$(sISBN, 1)) <= 7 Then
  iGroupe = 1
    ElseIf Val(Left$(sISBN, 2)) <= 94 Then
  iGroupe = 2
  ElseIf Val(Left$(sISBN, 3)) <= 995 Then
iGroupe = 3
ElseIf Val(Left$(sISBN, 4)) <= 9989 Then iGroupe = 4
    Else: iGroupe = 5
    End If
    'Segment de l'éditeur
    If Val(Mid$(sISBN, iGroupe + 1, 2)) <= 19 Then
  iEditeur = 2
    ElseIf Val(Mid$(sISBN, iGroupe + 1, 3)) <= 699 Then
  iEditeur = 3
  ElseIf Val(Mid$(sISBN, iGroupe + 1, 4)) <= 8399 Then
iEditeur = 4
ElseIf Val(Mid$(sISBN, iGroupe + 1, 5)) <= 89999 Then
    iEditeur = 5
    ElseIf Val(Mid$(sISBN, iGroupe + 1, 6)) <= 949999 Then
  iEditeur = 6
  Else: iEditeur = 7
    End If
    'Segment du titre
    iTitre = 8 - iEditeur
    'Formatage
    sGroupe = Left$(sISBN, iGroupe)
    sEditeur = Mid$(sISBN, iGroupe + 1, iEditeur)
    sTitre = Mid$(sISBN, iGroupe + iEditeur + 1, iTitre)
    sClef = Mid$(sISBN, iGroupe + iEditeur + iTitre + 1, 1)
    FormateISBN = sGroupe & "-" & sEditeur & "-" & sTitre & "-" & sClef
End Function
 
Public Function ISBN_EAN13(ByVal ISBN As String, ByVal sBookLand As String) As String
Dim NewISBN As String
Dim EAN13 As String
Dim sClef As String
    NewISBN = FiltreCar(ISBN, " ")
    NewISBN = FiltreCar(NewISBN, "-")
    'Enlever la clef de controle
    NewISBN = Left$(NewISBN, Len(NewISBN) - 1)
    EAN13 = sBookLand & NewISBN
    sClef = ClefEAN13(EAN13)
    ISBN_EAN13 = EAN13 & sClef
End Function
 
Public Function ClefEAN13(ByVal sEAN13 As String) As String
Dim L As String
Dim i As Integer
Dim Fact As Integer
Const Fact1 = 1
Const Fact2 = 3
Dim iClef As Integer
Dim sClef As String
Dim lTotal As Long
    If Len(sEAN13) <> 12 Then
  ClefEAN13 = False
  Exit Function
    End If
    Fact = Fact1
    For i = 1 To Len(sEAN13) Step 1
  L = Mid$(sEAN13, i, 1)
  lTotal = lTotal + (Val(L) * Fact)
  If Fact = Fact1 Then Fact = Fact2 Else Fact = Fact1
    Next
    iClef = lTotal Mod 10
    If iClef = 0 Then sClef = "0"
    If iClef >= 1 Then sClef = CStr(10 - iClef)
    ClefEAN13 = sClef
End Function
 
Public Function FormateEAN13(ByVal sEAN13 As String) As String
Dim sTemp As String
    If Len(sEAN13) <> 13 Then
  FormateEAN13 = ""
  Exit Function
    End If
    sTemp = Mid$(sEAN13, 1, 3) & " "
    sTemp = sTemp & Mid$(sEAN13, 4, 1) & " "
    sTemp = sTemp & Mid$(sEAN13, 5, 3) & " "
    sTemp = sTemp & Mid$(sEAN13, 8, 5) & " "
    sTemp = sTemp & Mid$(sEAN13, 13, 1)
    FormateEAN13 = sTemp
End Function
 
Public Function ISBN_Editeur(ByVal sISBN As String) As String
Dim iPos1 As Integer
Dim iPos2 As Integer
    If Len(sISBN) <> 13 Then
  		ISBN_Editeur = ""
  		Exit Function
    End If
 
    iPos1 = InStr(1, sISBN, "-", vbTextCompare)
    iPos2 = InStr(iPos1 + 1, sISBN, "-", vbTextCompare)
 
    ISBN_Editeur = Mid$(sISBN, iPos1 + 1, iPos2 - iPos1 - 1)
 
End Function