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