Vérifier la conformité d'un code ean (european article numbering) sur 13 caractères

Commenter

Contenu du snippet

Tout est dit !

Source / Exemple : 


Public Function bCodeEANValide(ByVal sCodeEAN13$, ByRef sMsgErr$) As Boolean
    
    ' Vérifier la conformité d'un code EAN
    '  (European Article Numbering) sur 13 caractères
    '  et renvoyer un message d'erreur le cas échéant
    
    If sCodeEAN13 = "" Then
        sMsgErr = "Le code EAN est vide"
        Exit Function
    End If
    
    Dim i%, iLen%
    iLen = Len(sCodeEAN13)
    If iLen <> 13 Then
        sMsgErr = "La longueur du code EAN est de " & _
            iLen & " caractère(s) au lieu de 13"
        Exit Function
    End If
    
    'sCodeEAN13 = "9780201134476" ' Exemple de code EAN valide
    Dim sCar$, iChiffre%, iSommepair%, iSommeImpair%
    Dim z%, m%, iSommeCtrl%, j%
    iSommepair = 0
    iSommeImpair = 0
    For i = 1 To iLen
        sCar = Mid$(sCodeEAN13, i, 1)
        If Asc(sCar) < Asc("0") Or Asc(sCar) > Asc("9") Then
            sMsgErr = "Le code EAN n'est pas numérique"
            Exit Function
        End If
        
        iChiffre = Asc(sCar) - Asc("0")
        
        If i = 13 Then
            ' Soit x la somme des chiffres pairs et
            '      y la somme des chiffres impairs
            ' On calcule z = 3x + y
            ' Soit m le premier nombre divisible par 10
            '  supérieur ou égal à z
            ' La somme de contrôle est  m - z
            iSommeCtrl = iChiffre
            z = 3 * iSommepair + iSommeImpair
            For j = z To z + 10
                If j Mod 10 = 0 Then
                    If j - z = iSommeCtrl Then
                        bCodeEANValide = True
                    Else
                        sMsgErr = "Le code EAN n'est pas conforme"
                    End If
                    Exit Function
                End If
            Next j
        End If
        
        If i Mod 2 = 0 Then
            iSommepair = iSommepair + iChiffre
        Else
            iSommeImpair = iSommeImpair + iChiffre
        End If
        
    Next i
    
End Function

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Patrice99)