[REGEX] Recherche Patten de capture, un défi ?Résolu

Question

Bonjour à tous,

J'essaie vainement de créer un Patten de capture.

Voici la chaine concernée:

85339147802789523626847310205970239AR2950793415PC7098624031

De cette chaine, j'aimerais capturer les caractères qui sont après 10 jusqu'à AR.

Soit : 205970239

Les contraintes:

Après 85 il y a toujours 14 caractères variable.

Après 36 il y a toujours 6 caractères variable.

Le nombre de caractères entre 10 et AR et compris entre 1 et 20 caractères variable.

Après 29 il y a toujours 6 caractères variable.

Après 15 le nombre de caractères et compris entre 1 et 20 caractères variable.

85, 36, le couple 10 et AR, 29 et 15 serons toujours présent.

85 est toujours en début de chaine.

Les positions de 36, du couple 10 et AR, 29 et 15 peuvent changer

Dans ma chaine d'exemple nous avons:

85, 36, le couple 10 et AR, 29 et 15

Ça pourrait être:

85, 29, le couple 10 et AR, 15 et 36

Ou encore:

85, le couple 10 et AR, 15, 36, 29

J'espère être assez claire et que vous pourrez m'aider ?

Whismeril · Answer

Bonsoir

question bête, si ce qui compte ce sont les caractères entre 10 et AR, le reste (85, 15, 36, 29) a-t-il vraiment de l'importance ?

Par exemple, existe-t-il des séquences contenant 10 et AR mais sans 85, 15, 36, 29 et qui du coup ne serait pas à capturer ?

NeriXs · Answer

Bonsoir,
Effectivement ce qui compte ce sont les caractères entre 10 et AR!
J'essaie de jouer avec (.+?) mais je sèche toujours !

Whismeril · Answer

(?<=10).{1,20}(?=AR)

Un exemple ici https://regex101.com/r/Q8ToAf/1

La dernière ligne n'est pas capturée, car il y a 21 caractères entre 10 et AR

NeriXs · Answer

Il y a quelque chose qui m'échappe !

85(\d{14})36(\d{6})10(?<=10).{1,20}(?=AR)29(\d{6})15(PC\d+)$

85339147802789523626847310205970239AR2950793415PC7098624031

https://regex101.com/r/n8MPCT/1

Whismeril · Answer

Cette instruction

(?<=10)

veut dire que 10 doit être avant la capture mais pas en faire partie.

Du coup, tu ne peux pas la mettre au milieu d'un pattern, idem pour (?=AR) qui signifie après la capture.

NeriXs · Answer

Comment pourrais-je modifier mon code VBA pour être compatible?

Function ExtractInfoGS1_128(Chaine As String, numInfo As Integer) As String
    ' Création de l'objet RegExp
    ExtractInfoGS1_128 = "Erreur"
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Global = True
    regEx.IgnoreCase = True
    regEx.Pattern = "85(\d{14})36(\d{6})10((?<=10).{1,20}(?=AR))29(\d{6})15(PC\d+)$" 'Expression régulière
    If matches.Count = 1 Then
       Debug.Print "Identifiant de l'appareil : ", matches(0).submatches(0)
       Debug.Print "Date de fabrication : ", matches(0).submatches(1)
       Debug.Print "Date d'expiration : ", matches(0).submatches(2)
       Debug.Print "Numéro de lot/lot : ", matches(0).submatches(3)
       Debug.Print "Numéro de série : ", matches(0).submatches(4)
       ExtractInfoGS1_128 = matches(0).submatches(numInfo - 1)
    End If
End Function

Sub TestRegex()
Debug.Print ExtractInfoGS1_128("85339147802789523626847310205970239AR2950793415PC22412085", 4)
End Sub

Whismeril · Answer

Ha c'est du VBA

le moteur de regex de VBA est ancien, je ne sais pas s'il prend en compte les prefixes et les suffixes.

Mais de toute façon, ils ne peuvent pas être au milieu.

D'autre part, quand je t'ai demandé si les 85, 36 et consorts avaient de l'importance tu m'as répondu non, donc pourquoi les remettre alors la regex qui ne s'en préoccupe pas est simple?

NeriXs · Answer

Bonjour @Whismeril,

Effectivement le moteur de RegEx de VBA ne prend en compte les préfixes et les suffixes!

Désolé, quand j'ai répondu que les 85, 36 et consorts n'avaient pas d'importance, j'ai pensé que cela pourrait être géré séparément.

Dans le genre:

Function ExtractInfo(txt As String, matrice) As String 
    With CreateObject("VBScript.RegExp")
        .Pattern = matrice
        .IgnoreCase = True
        ExtractInfo = .Execute(txt)(0)
    End With
End Function

Sub test10()
    Dim Chaine As String
    Chaine = "85339147802789523626847310205970239AR2950793415PC7098624031"
	Extract85 = ExtractInfo(Chaine, "(?<=85).(\d{14})") 
	Extract36 = ExtractInfo(Chaine, "(?<=36).(\d{6})")
	Extract10 = ExtractInfo(Chaine, "(?<=10).{1,20}(?=AR)") 
	Extract29 = ExtractInfo(Chaine, "(?<=29).(\d{6})") 
	Extract15 = ExtractInfo(Chaine, "(?<=15).{1,20}$") 
MsgBox Extract85 & vbCrLf & Extract36 & vbCrLf & Extract10 & vbCrLf & Extract29 & vbCrLf & Extract15
End Sub

Mais vu le moteur de RegEx de VBA pose problème !

Une autre approche est-elle possible ?

Whismeril · Answer

Ok, donc finalement tu cherches à récupérer chacune des parties.

Est ce qu'une chaine dans laquelle il manquerait, une des "balises" doit être rejetée?

Est ce qu'une chaîne dans laquelle, une des balises est en double doit être rejetée?

PS, pour la coloration syntaxique, il faut choisir Basic comme langage dans la liste déroulante.

NeriXs · Answer

Bonjour,

J'ai pu "j'espère" résoudre mon problème de préfixes et suffixes!
Pour la balise 10 en fin de code-barres:
"10(.{1,20})$"
Pour la balise 10 qui n'est pas la dernière balise du code-barres:
"10(.{1,20})(?=GS)"
C'est la même chose pour la balise 21.

GS est la balise de fin des chaines de caractères lié aux balises 10 et 21.

Ça fonctionne pour le code-barres:
0100883873867792112209271723092710220927GS21PC23713163

Modification du code pour être en adéquation avec GS1, donc correction des informations:

01 = Numéro d'article (GTIN) = 14 caractères.
11 = Date de production = 6 caractères.
17 = Date d'expiration = 6 caractères.
10 = Le numéro de lot = variable 1 à 20 caractères, Jusqu’à GS, sauf si dernière position.    
21 = Le numéro de série = variable 1 à 20 caractères, Jusqu’à GS, sauf si dernière position.

Pour répondre aux questions:

1) Est-ce qu'une chaine dans laquelle il manquerait, une des "balises" doit être rejetée?

En considérant que les balises sont:
01, 11, 17, 10, 21 et GS.

Non la chaine ne doit pas être rejetée, tous les articles non pas forcément de numéro de lot "10", de numéro de série "21" ou de Date d'expiration "17"…
Exemple:
(01)05862455391075(11)220328(17)231231

2) Est-ce qu'une chaîne dans laquelle, une des balises est en double doit être rejetée?

Les articles qui possèdent un numéro de lot "10" et\ou un numéro de série "21" sont variables et ont la balise "GS" pour délimiter la fin de la chaine, sauf si le numéro de lot "10" ou le numéro de série "21" et en fin de chaine, dans ce cas pas de balise "GS"

Exemple, avec la balise de fin "GS" de "10" et sans balise "GS" de fin de "21" car il est en dernière position.
(01)00883873867792(11)220927(17)230927(10)220927GS(21)PC23713163

Exemple, avec la balise de fin "GS" de "10" et balise "GS" de fin de "21" car aucun des deux est en dernière position.
(01)03400934672248(21)10045423841916GS(10)X09897AGS(17)260430

Il ne peut pas y avoir de doublons sur les balises "01, 10, 11, 17, et 21" seulement des doublons sur GS.

Compléments d'informations:

Les balises peuvent avoir un ordre différant sauf "01" qui est toujours en 1er.
01, 11, 17, 10+GS, 21
01, 11, 10+GS, 21+GS, 17
01, 17, 11, 10+GS, 21

Comme évoqué plus haut, certaines balises peuvent manquer.
01, 11, 17
01, 10+GS, 21
01, 10+GS, 11
01, 11, 17, 10
01, 17, 10+GS, 21
01, 11, 21+GS, 17

Je pense que j'ai fait le tour, voici le code:

Function ExtractInfo(txt As String, matrice) As String
    With CreateObject("VBScript.RegExp")
        .Pattern = matrice
        .IgnoreCase = True
        If .test(txt) Then ExtractInfo = .Execute(txt)(0).submatches(0)
    End With
End Function

Sub test10()
    Dim Chaine As String
    
' -----------------------------------------------------------------------------------------

Chaine = "0100883873867792112209271723092710220927GS21PC23713163" 'OK
    
    'Result
    '(01)00883873867792
    '(11)220927
    '(17)230927
    '(10)220927
    '(21)PC23713163 (No GS with 21, it's normal, it's in last position).
    
' -----------------------------------------------------------------------------------------
    
    'Chaine = "01034009301383801726013110DB20323GS2195918770106437" 'Not OK
    
    'Result
    '(01)03400930138380
    '(11) Not in the barcode, Displays a blank in the MsgBox.
    '(17)260131
    '(10)DB20323
    '(21)95918770106437 (No GS with 21, it's normal, it's in last position).
    
' -----------------------------------------------------------------------------------------
    
    'Chaine = "01034009301884081726060010ABS3514" 'Not OK

'Result
    '(01)03400930188408
    '(11) Not in the barcode, Displays a blank in the MsgBox.
    '(17) 260600
    '(10) Not displayed ???, expected result: ABS3514 (No GS with 10, it's normal, it's in last position).
    '(21) Not in the barcode.
    
' -----------------------------------------------------------------------------------------
    
    'Chaine = "01034009346722482110045423841916GS10X09897AGS17260430" 'Not OK
    
    'Result
    '(01) 03400934672248
    '(11) Not in the barcode.
    '(21) Wrong displayed result: 004542, GS processing missing, expected result:10045423841916
    '(10) Wrong displayed result: 045423841916, expected result: X09897A
    '(17) 260430
    
' -----------------------------------------------------------------------------------------
    
    Extract01 = ExtractInfo(Chaine, "01(\d{14})")
    Extract11 = ExtractInfo(Chaine, "11(\d{6})")
    Extract17 = ExtractInfo(Chaine, "17(\d{6})")
    Extract10 = ExtractInfo(Chaine, "10(.{1,20})(?=GS)")
    Extract21 = ExtractInfo(Chaine, "21(.{1,20})$")
    MsgBox Extract01 & vbCrLf & Extract11 & vbCrLf & Extract17 & vbCrLf & Extract10 & vbCrLf & Extract21
End Sub

Quelques exemples de codes-barres sont commentés avec le résultat et les dysfonctionnements rencontrés.

Whismeril · Answer

Le problème à découper la séquence par partie est le risque de collision.

Par exemple, s'il y a 11 dans les caractères qui suivent le 01, la capture commencera là. Cf cet exemple, les 4 premières lignes sont celles de ton code et la dernière est la précédente que j'ai modifiée pour illustrer.

À mon sens, il faut essayer de trouver un(des) pattern qui t'immunise de ce risque.

soit un pattern global (ha mon avis le plus sûr, mais pas le plus simple)
	soit des patterns plus "safes", par exemple 11 et 17 sont des dates, donc utiliser des regex qui excluent les combinaisons de chiffres qui ne représentent pas une date, et après les 6 chiffres, il ne peut y avoir qu'un 11, un 17, un 10, un 21 ou la fin de chaine. Mais malgré ça, la collision n'est pas totalement exclue

Je n'aurais pas trop le temps de me pencher sérieusement sur la question aujourd'hui. J'y regarderai ce week-end.

NeriXs · Answer

Dans tes 2 ajouts, ce cas de figure ne devrait pas arriver.

La balise 01 et toujours en 1er position du code-barres et est toujours suivit de 14 caractères.

Sur ton 1er exemple:

01034009346722482110045423841916GS10X09897AGS17260430

IL y a 15 caractères entre la balise 01 et la balise 11, ce ne peut pas être le cas (toujours 14).

Dans le 2éme exemple:

01034009346711482110045423841916GS10X09897AGS17260430

Si on traite 01 en 1er les 14 caractères qui le suive ne devraient plus faire partie de l'équation et donc ignoré, non?

Pour rappel:

01 toujours suivit de 14 caractères.

11 et 17 toujours suivit de 6 caractères.

10 et 21 suivit de 1 à 20 caractères, Jusqu’à balise GS, sauf si dernière position.

Concernant 11 et 17 les dates, elles peuvent être au format jjmmaa ou aammjj il me semble même avoir vu mmaaaa ou aaaamm.

Le fait que le moteur RegEx de VBA soit ancien ne va pas faciliter les choses!

Whismeril · Answer

IL y a 15 caractères entre la balise 01 et la balise 11, ce ne peut pas être le cas (toujours 14).

J'ai copié collé les séquences commentées de ton code en #10.

J'ai juste changé un 22 en 11 entre la 4eme ligne, issue de ton code et la 5éme

NeriXs · Answer

Dans le code-barres :
01034009346722482110045423841916GS10X09897AGS17260430
Le 14 eme caractère après la balise 01, c'est une balise 21.

Il peut y avoir un 11 entre les balises 01 et 21, c'est un peu pour cela que j'avais pensé aux patterns séparés et éventuellement exclure les parties déjà traitées du code-barres source et le recréer toute à la fin.

NeriXs · Answer

Peut-être une piste? Ne semble pas fonctionner en VBA J'ai copié collé les séquences commentées de mon code en #10 et ajouté les crochets " [] " autour des balises GS (Là une petite explication s'impose !). 0100883873867792112209271723092710220927[GS]21PC23713163 01034009301383801726013110DB20323[GS]2195918770106437 01034009301884081726060010ABS3514 01034009346722482110045423841916[GS]10X09897A[GS]17260430 https://regex101.com/r/IDcO7Z/1 Options gmx - global (don't return after first match) - multi line (^ and $ match start/end of line) -extended (ignore whitespace) ^(?: 01(?P.{14})| 10(?P(?:(?!\[GS]).){1,20})(?:\[GS]|$)| 17(?P.{6})| 11(?P.{6})| 21(?P(?:(?!\[GS]).){1,20})(?:\[GS]|$) )+$

Whismeril · Answer

Ce qui ne marche pas en vba, c'est (au moins)  les groupes nommés.

Ça on peut s'en passer, il faut juste savoir le numéro du groupe qu'on cherche.

Il faut voir si les options sont acceptées.

Je n'ai pas fait de tests approfondis. Mais j'aurais un peu de temps ce matin.

Le risque avec les "ou" comme tu l'as fait c'est de faire matcher une séquence avec des doublons, mais plus haut tu indiques qu'il ne peut pas y en avoir. Donc ça ne serait pas un problème. Il faut juste en être conscient. C'est d'ailleurs sur une combinaison de ou que je voulais plancher.

Et à priori, comme tu as inclus la balise 01 dans le ou, ça doit pouvoir matcher si elle n'est pas en première position.

Whismeril · Answer

Essaye ceci.

Sub TestNeriXs()
Dim pattern01, pattern11, pattern17, pattern10, pattern21, pattern, code, capture, balise, resultat As String
Dim regex, matches As Object
Dim codes As Variant

codes = Array("0100883873867792112209271723092710220927GS21PC23713163", "01008838738677921723092710220927GS21PC23713163GS11220927", "0100883873867792112209271723092710220927GS21PC23713163", "01034009301383801726013110DB20323GS2195918770106437", "01034009301884081726060010ABS3514", "01034009346722482110045423841916GS10X09897AGS17260430")

Set regex = New RegExp

pattern01 = "^(01.{14})"
pattern11 = "(11\d{6})"
pattern17 = "(17\d{6})"
pattern10 = "(10.{1,20}?)(?:GS|$)"
pattern21 = "(21.{1,20}?)(?:GS|$)"

pattern = pattern01 + "(?:" + pattern11 + "|" + pattern17 + "|" + pattern10 + "|" + pattern21 + ")+$"

regex.pattern = pattern
For Each code In codes
    If (regex.Test(code)) Then
        Set matches = regex.Execute(code)
        For Each Match In matches
            a = Match.SubMatches.Count
            For i = 0 To a - 1
                capture = Match.SubMatches.Item(i)
                balise = Left(capture, 2)
                Select Case balise
                    Case "01"
                        resultat = balise + ": " + Right(capture, 14) + ", "
                
                    Case "11", "17"
                        resultat = resultat + balise + ": " + Right(capture, 6) + ", "
                
                    Case "10", "21"
                        resultat = resultat + balise + ": " + Right(capture, Len(capture) - 2) + ", "
                End Select
            Next
            Debug.Print code
            Debug.Print resultat
        Next
    End If
Next
End Sub

Pour voir le résultat, il faut afficher la fenêtre "Exécution"

Avec les quelques codes que j'ai mis en entrée, ça donne

0100883873867792112209271723092710220927GS21PC23713163
01: 00883873867792, 11: 220927, 17: 230927, 10: 220927, 21: PC23713163, 
0100883873867792112209271723092710220927GS21PC23713163
01: 00883873867792, 11: 220927, 17: 230927, 10: 220927, 21: PC23713163, 
01008838738677921723092710220927GS21PC23713163GS11220927
01: 00883873867792, 11: 220927, 17: 230927, 10: 220927, 21: PC23713163, 
0100883873867792112209271723092710220927GS21PC23713163
01: 00883873867792, 11: 220927, 17: 230927, 10: 220927, 21: PC23713163, 
01034009301383801726013110DB20323GS2195918770106437
01: 03400930138380, 17: 260131, 10: DB20323, 21: 95918770106437, 
01034009301884081726060010ABS3514
01: 03400930188408, 17: 260600, 10: ABS3514, 
01034009346722482110045423841916GS10X09897AGS17260430
01: 03400934672248, 17: 260430, 10: X09897A, 21: 10045423841916,

Si ça te convient, j'expliquerai le pouquoi du comment

NeriXs · Answer

J'ai des erreurs de compilation, variable non défini et d'objet requis.

J'ai ajouté option explicit et essaie de débugger.

Whismeril · Answer

Au temps pour moi, j'avais pas déclaré les variable d'itération des for

Option Explicit

Sub TestNeriXs()
Dim pattern01, pattern11, pattern17, pattern10, pattern21, pattern, code, capture, balise, resultat As String
Dim regex, matches, Match As Object
Dim codes As Variant
Dim i As Integer

codes = Array("0100883873867792112209271723092710220927GS21PC23713163", "01008838738677921723092710220927GS21PC23713163GS11220927", "0100883873867792112209271723092710220927GS21PC23713163", "01034009301383801726013110DB20323GS2195918770106437", "01034009301884081726060010ABS3514", "01034009346722482110045423841916GS10X09897AGS17260430")

Set regex = New RegExp

pattern01 = "^(01.{14})"
pattern11 = "(11\d{6})"
pattern17 = "(17\d{6})"
pattern10 = "(10.{1,20}?)(?:GS|$)"
pattern21 = "(21.{1,20}?)(?:GS|$)"

pattern = pattern01 + "(?:" + pattern11 + "|" + pattern17 + "|" + pattern10 + "|" + pattern21 + ")+$"

regex.pattern = pattern
For Each code In codes
    If (regex.Test(code)) Then
        Set matches = regex.Execute(code)
        For Each Match In matches
            For i = 0 To Match.SubMatches.Count - 1
                capture = Match.SubMatches.Item(i)
                balise = Left(capture, 2)
                Select Case balise
                    Case "01"
                        resultat = balise + ": " + Right(capture, 14) + ", "
                
                    Case "11", "17"
                        resultat = resultat + balise + ": " + Right(capture, 6) + ", "
                
                    Case "10", "21"
                        resultat = resultat + balise + ": " + Right(capture, Len(capture) - 2) + ", "
                End Select
            Next
            Debug.Print code
            Debug.Print resultat
        Next
    End If
Next
End Sub

NeriXs · Answer

Erreur de compilation sur New RegExp, type non défini.

Whismeril · Answer

Étonnant, tu n'as pas inclus les regex dans ton projet....

NeriXs · Answer

Oups, désolé, je suis partie sur un autre poste et ne l'avais pas ajouté!
Je test et reviens rapidement
En tous cas merci pour le temps passé!

NeriXs · Answer

Parfait, tous les codes-barres que j'ai testés ont matchés!
Pour l'utilisation final et si tu as encore un peu de temps.
La saisie du code-barres depuis un InputBox.
Les données extraites sur Feuil1

Idéalement:
La reprise du code-barres initial avec des parenthèses autour des balises, mais sans les balises GS
Les éléments du code-barres en dessous avec dénomination.

Pour:
0100883873867792112209271723092710220927GS21PC23713163
01: 00883873867792, 11: 220927, 17: 230927, 10: 220927, 21: PC23713163,

Cela donnerait:

(01)00883873867792(11)220927(17)230927(10)220927(21)PC23713163

(01) GTIN de l’article: 00883873867792
(11) Date de production: 220927
(17) Date d'expiration : 230927
(10) Numéro de lot: 220927
(21) Numéro de série: PC23713163

Je relis le code avant tes explications "le pourquoi du comment" ;)

Whismeril · Answer

Alors, le pourquoi du comment.

D'abord, je t'ai posé plein de question pour cerner le besoin, parce que forcément, je n'ai pas toute ton expérience sur le sujet et pour poser des hypothèses réalistes, il me fallait des infos.

Donc forcément, c'était un peu long.

Ensuite, regex VBA => exit les préfixes/suffixes (qu'ils soient obligés ou interdits) et les groupes nommés.

Pour les groupes, il faut faire en sorte de savoir de quelles balises on parle, et pour ça mon axiome de départ a été : la balise fait partie de la capture et on trie ensuite grâce aux 2 premiers caractères.

Pour les pré/suffixes, il faut trouver d'autres syntaxes.

Mes hypothèses ont été

Balise
			Position
			Valeur

01
			début
			14 caractères

11
			n'importe où
			6 chiffres

17
			n'importe où
			6 chiffres

10
			n'importe où
			1 à 20 caractères + GS ou fin de séquence

21
			n'importe où
			1 à 20 caractères + GS ou fin de séquence

À partir de là, j'ai tenté un premier jeu de patterns, qui s'est révélé bon pour les 3 premiers.

Pattern unitaire
			Signification

^(01.{14})
			Début de séquence, groupe qui capture la balise et 14 caractères

(11\d{6})
			Groupe qui capture la balise et 6 chiffres

(17\d{6})

Mais ça ne marchait pas pour les balises 10 et 21.

Sur tes codes barres de test, il y en avait un où il y avait un 10 et un 21 à la suite (ou inversement) dont qui totalisait moins de 20 caractères. Du coup, il n'y avait qu'une capture qui s'est arrêtée au 2eme GS. Du coup, il fallait ajouter une contrainte pour que la capture soit la plus courte possible (en ajoutant ? après {1,20} )

Pattern unitaire
			Signification

^(01.{14})
			Début de séquence, groupe qui capture la balise et 14 caractères

(11\d{6})
			Groupe qui capture la balise et 6 chiffres

(17\d{6})

(10.{1,20}?)(?:GS|$)
			Groupe qui capture la balise, puis de 1 à 20 caractères, mais le plus court possible, puis GS ou fin de séquence qui ne sont pas dans le groupe

(21.{1,20}?)(?:GS|$)

Ensuite, il fallait mettre tout ça dans une seule regex, avec des ou comme tu l'avais présenti, sauf la balise 01 qui est toujours présent et au début de la séquence, donc ne doit pas être dans le "ou".

Ensuite ce qui est dans le "ou" arrive plusieurs fois, mais on ne sait pas dire combien (donc un + comme quantificateur).

Enfin la capture va jusqu'à la fin de la séquence.

Si on appelle pXX chaque pattern unitaire ça donne

p01(?:p11|p17|p10|p21)+$

Après avoir validé ça sur regex101, je l'ai transposé en VBA.

J'ai gardé l'idée des patterns unitaires pour plus de lisibilité et surtout c'est plus facile de retoucher un pattern unitaire si besoin qu'une grande regex.

Ce qui a donné ce code, que j'ai commenté

Sub TestNeriXs()
Dim pattern01, pattern11, pattern17, pattern10, pattern21, pattern, code, capture, balise, resultat As String
Dim regex, matches, Match As Object
Dim codes As Variant
Dim i As Integer

'mise de plusieurs codes de test dans un tableau
codes = Array("0100883873867792112209271723092710220927GS21PC23713163", "01008838738677921723092710220927GS21PC23713163GS11220927", "0100883873867792112209271723092710220927GS21PC23713163", "01034009301383801726013110DB20323GS2195918770106437", "01034009301884081726060010ABS3514", "01034009346722482110045423841916GS10X09897AGS17260430")

Set regex = New RegExp

'écriture des patterns unitaires
pattern01 = "^(01.{14})"
pattern11 = "(11\d{6})"
pattern17 = "(17\d{6})"
pattern10 = "(10.{1,20}?)(?:GS|$)"
pattern21 = "(21.{1,20}?)(?:GS|$)"

'fusion du pattern complet
pattern = pattern01 + "(?:" + pattern11 + "|" + pattern17 + "|" + pattern10 + "|" + pattern21 + ")+$"

regex.pattern = pattern

'test de chaque code du tableau
For Each code In codes
    'on vérifie d'abord que la regex matche
    If (regex.Test(code)) Then
        'si oui, on recoupère les datas
        'comme je ne savais pas si tu récupères les codes un à un ou en lot (dans un fichier par exemple),
        'je suis parti du principe qu'il pouvait y avoir plusieurs matches
        Set matches = regex.Execute(code)
        
        For Each Match In matches
            'pour chaque match, on récupère les groupes
            For i = 0 To Match.SubMatches.Count - 1
                capture = Match.SubMatches.Item(i)
                'on extrait la balise pour affecter le résultat comme il faut
                balise = Left(capture, 2)
                'j'ai choisi un select case, car ça se prête bien à la situation
                Select Case balise
                    Case "01"
                        resultat = balise + ": " + Right(capture, 14) + ", "
                
                    Case "11", "17"
                        resultat = resultat + balise + ": " + Right(capture, 6) + ", "
                
                    Case "10", "21"
                        resultat = resultat + balise + ": " + Right(capture, Len(capture) - 2) + ", "
                End Select
            Next
            'on imprime le résultat dans la console
            Debug.Print code
            Debug.Print resultat
        Next
    End If
Next
End Sub

Whismeril · Answer

Que l'on peut modifier par exemple comme ça

Option Explicit

Sub TestNeriXs()
Dim pattern01, pattern11, pattern17, pattern10, pattern21, pattern, code, capture, balise, resultat, gtin, dateProd, dateExpi, numLot, numSerie As String
Dim regex, matches, Match As Object
Dim codes As Variant
Dim i As Integer

'mise de plusieurs codes de test dans un tableau
codes = Array("0100883873867792112209271723092710220927GS21PC23713163", "01008838738677921723092710220927GS21PC23713163GS11220927", "0100883873867792112209271723092710220927GS21PC23713163", "01034009301383801726013110DB20323GS2195918770106437", "01034009301884081726060010ABS3514", "01034009346722482110045423841916GS10X09897AGS17260430")

Set regex = New RegExp

'écriture des patterns unitaires
pattern01 = "^(01.{14})"
pattern11 = "(11\d{6})"
pattern17 = "(17\d{6})"
pattern10 = "(10.{1,20}?)(?:GS|$)"
pattern21 = "(21.{1,20}?)(?:GS|$)"

'fusion du pattern complet
pattern = pattern01 + "(?:" + pattern11 + "|" + pattern17 + "|" + pattern10 + "|" + pattern21 + ")+$"

regex.pattern = pattern

'test de chaque code du tableau
For Each code In codes
    'on vérifie d'abord que la regex matche
    If (regex.Test(code)) Then
        'si oui, on recoupère les datas
        'comme je ne savais pas si tu récupères les codes un à un ou en lot (dans un fichier par exemple),
        'je suis parti du principe qu'il pouvait y avoir plusieurs matches
        Set matches = regex.Execute(code)
        
        For Each Match In matches
            'pour chaque match, on récupère les groupes
            For i = 0 To Match.SubMatches.Count - 1
                capture = Match.SubMatches.Item(i)
                'on extrait la balise pour affecter le résultat comme il faut
                balise = Left(capture, 2)
                'j'ai choisi un select case, car ça se prête bien à la situation
                Select Case balise
                    Case "01"
                        gtin = Right(capture, 14)
                        resultat = "(01)" + gtin
                
                    Case "11"
                        dateProd = Right(capture, 6)
                        resultat = resultat + "(11)" + dateProd
                        
                    Case "17"
                        dateExpi = Right(capture, 6)
                        resultat = resultat + "(17)" + dateExpi
                        
                    Case "10"
                        numLot = Right(capture, Len(capture) - 2)
                        resultat = resultat + "(10)" + numLot
                        
                    Case "21"
                        numSerie = Right(capture, Len(capture) - 2)
                        resultat = resultat + "(21)" + numSerie
                End Select
            Next
            'on imprime le résultat dans la console
            Debug.Print resultat
            Debug.Print "(01) GTIN de l’article: " + gtin
            Debug.Print "(11) Date de production: " + dateProd
            Debug.Print "(17) Date d'expiration : " + dateExpi
            Debug.Print "(10) Numéro de lot: " + numLot
            Debug.Print "(21) Numéro de série: " + numSerie
        Next
    End If
Next
End Sub

NeriXs · Answer

Bonjour @Whismeril,

Un grand merci pour le travail effectué, les explications, le recueil des informations afin de bien cerner les besoins, très professionnel!

J'ai omis un élément que j'avais géré en amont.

Comme pour la balise GS, le scanne d'un code-barres peut afficher une balise en tout début du code-barres.

Ces balises sont:
]C1 = GS1-128 BarCode
]e0 = GS1 DataBar
]d2 = GS1 DataMatrix
]Q3 = GS1 QR Code
]J1 = GS1 DotCode

Ces balises sont couramment appelées FNC1

Exemple:
]C10100883873867792112207071723070710220707GS21PC22412085

Ces Balises FNC1 donnes juste une information et sont inutiles au traitement du Code-barres et ne sont pas toujours présentes.
J'avais traité de cette façon:

=SUBSTITUE(SUBSTITUE(SUBSTITUE(SUBSTITUE(SUBSTITUE(A5; "]C1"; ""); "]e0"; ""); "]d2"; ""); "]Q3"; ""); "]J1"; "")

Ce serait plus propre via RegEx de les supprimer si présentes, mais ça ne match plus quand j'essaie.

Pourrais-tu regarder?

J'ai repris le code pour ne gérer qu'un code a la fois, oui désolé je ne t'avais pas donné plus de précision.

Option Explicit

Sub TestNeriXs()
Dim pattern01, pattern11, pattern17, pattern10, pattern21, pattern, code, capture, balise, resultat, gtin, dateProd, dateExpi, numLot, numSerie As String
Dim regex, matches, Match As Object
Dim codes As Variant
Dim i As Integer
            
code = "0100883873867792112209271723092710220927GS21PC23713163"

Set regex = New RegExp

'écriture des patterns unitaires
pattern01 = "^(01.{14})"
pattern11 = "(11\d{6})"
pattern17 = "(17\d{6})"
pattern10 = "(10.{1,20}?)(?:GS|$)"
pattern21 = "(21.{1,20}?)(?:GS|$)"

'fusion du pattern complet
pattern = pattern01 + "(?:" + pattern11 + "|" + pattern17 + "|" + pattern10 + "|" + pattern21 + ")+$"

regex.pattern = pattern

'on vérifie d'abord que la regex matche
    If (regex.Test(code)) Then
        'si oui, on recoupère les datas
        Set matches = regex.Execute(code)
        
        For Each Match In matches
            'pour chaque match, on récupère les groupes
            For i = 0 To Match.SubMatches.Count - 1
                capture = Match.SubMatches.Item(i)
                'on extrait la balise pour affecter le résultat comme il faut
                balise = Left(capture, 2)
                'j'ai choisi un select case, car ça se prête bien à la situation
                Select Case balise
                    Case "01"
                        gtin = Right(capture, 14)
                        resultat = "(01)" + gtin
                
                    Case "11"
                        dateProd = Right(capture, 6)
                        resultat = resultat + "(11)" + dateProd
                        
                    Case "17"
                        dateExpi = Right(capture, 6)
                        resultat = resultat + "(17)" + dateExpi
                        
                    Case "10"
                        numLot = Right(capture, Len(capture) - 2)
                        resultat = resultat + "(10)" + numLot
                        
                    Case "21"
                        numSerie = Right(capture, Len(capture) - 2)
                        resultat = resultat + "(21)" + numSerie
                End Select
            Next
            'on imprime le résultat dans la console
            Debug.Print resultat
            Debug.Print "(01) GTIN de l’article: " + gtin
            Debug.Print "(11) Date de production: " + dateProd
            Debug.Print "(17) Date d'expiration : " + dateExpi
            Debug.Print "(10) Numéro de lot: " + numLot
            Debug.Print "(21) Numéro de série: " + numSerie
        Next
    End If
End Sub

Whismeril · Answer

Le pattern01 part du principe que le code barre commence par la balise 01.

Si une balise FNC1 est présente, ça n'est plus le cas et donc ça ne matche pas.

Option 1 enlever le "^" au début du pattern et la capture commencera au premier 01. Mais si tu as un code en entrée qui ne correspond pas aux autres balises, ça pourrait mettre le bazar.

Option 2, modifier le pattern01 pour qu'il accepte ces balises en option, pas testé, mais à priori ça devrait ressembler à

"^(?:](?:C1|e0|d2|Q3|J1))?(01.{14})"

NeriXs · Answer

Solution 2 validée, ça match avec et sans FNC1, merci.

J'aimerais exposer une difficulté qui n'est pas liée directement à la demande initiale, mais qui l'impact.

Je me lance ici, mais si tu préfères que j'ouvre un nouveau poste dis le moi.

Cela concerne la balise GS.
Celle-ci fait partie (enfin je crois) des caractères non imprimables.

GS     = Group Separator
          = ASCII Code 29
          = Hexadecimal Code 1D
          = Unicode Escape Code \u001d

Sous NotePad ++, en saisissant au clavier la combinaison de douche Alt + 029, GS apparait sur fond noir.

Toujours sous NotePad++, onglet recherche, puis onglet remplacer
En saisissant \x puis le code GS hex 1D.
Soit:

Recherche: \x1D
Remplacer par: GS

Mode de recherche: Expression régulière

Le GS non imprimable et bien remplacé.

Un test entre NotePad++ et excel

Sous NotePad++ saisir 123 la combinaison de touche Alt+029 puis 456.
On voit bien 123GS456

En copiant cette ligne dans une cellule Excel on voix seulement 123456.

En re-copiant cette cellule et la collant sous NotePad++, on a bien 123GS456.

Le GS n'est pas vu mais est bien dans la cellule Excel.

Je cherche donc à faire la même chose.

Quelques pistes:

https://stackoverflow.com/questions/37024107/remove-unicode-characters-in-a-string

https://www.linkedin.com/pulse/removing-non-printing-characters-from-text-excel-using-ejaz-ahmed

https://stackoverflow.com/questions/47506560/function-which-removes-only-non-ascii-characters-in-a-column-in-access-table

https://stackoverflow.com/questions/41882525/vba-how-to-remove-non-printable-characters-from-data

Whismeril · Answer

Essaye avec

"(10.{1,20}?)(?:GS|$|\x1d)"

pour les patterns 10 et 21, ça devrait matcher si GS est écrit en "texte" ou si c'est le caractère x1d.

NeriXs · Answer

Arfff, je suis une tête de mule!

Je cherchais absolument à remplacer la balise GS soit \x1d par un GS écrit en "texte".
Ce n'est apparemment pas possible, il suffisait de l'exploiter.
3 H que je suis là-dessus
Ton pattern fonction. MERCI!!

Ça fonctionne aussi avec le D en majuscule.
Au passage attention, dans le code quand on utilise 1 \x1d un espace et ajouté en fin de ligne et 2 espaces si 2 \x1d sont utilisés.
Il ne faut surtout pas les supprimer car ça ampute le pattern.

J'ai commencé un UserForm pour interfacer le projet.
Je n'ai pas encore compris comment interagir avec ces éléments
En exemple, si tu pouvais me mettre en place l'utilisation du TextBox nommé "TxtCodeBarres" a la place de (code = "01034009346722482110045423841916GS10X09897AGS17260430") du Module?

Ça m'aiderait beaucoup.

Lien pour le téléchargement:
https://www.dropbox.com/scl/fi/cxlvmtmsev3626xrzh8fm/D-codeur-Code-Barres-GS1-128.xlsm?rlkey=1lgx32u2g4v3yksoqb67bs1co&dl=0

Whismeril · Answer

Je n'aurais pas VBA sous la main avant ce soir. Mais de mémoire, selon le VB, il y a 2 possibilités avec les textbox

Code = TextBox.Value
Code = TextBox.Text

Whismeril · Answer

Le code modifié comme ça

Option Explicit

Function TestNeriXs(code As String) As String
Dim pattern01, pattern11, pattern17, pattern10, pattern21, pattern, capture, balise, resultat, gtin, dateProd, dateExpi, numLot, numSerie As String
Dim regex, matches, Match As Object
Dim i As Integer

Set regex = New RegExp

'écriture des patterns unitaires
pattern01 = "^(01.{14})"
pattern11 = "(11\d{6})"
pattern17 = "(17\d{6})"
pattern10 = "(10.{1,20}?)(?:GS|$)"
pattern21 = "(21.{1,20}?)(?:GS|$)"

'fusion du pattern complet
pattern = pattern01 + "(?:" + pattern11 + "|" + pattern17 + "|" + pattern10 + "|" + pattern21 + ")+$"

regex.pattern = pattern

'valeur par défaut si la regex ne matche pas
resultat = "Code incorrect"

'on vérifie d'abord que la regex matche
If (regex.Test(code)) Then
    'si oui, on recoupère les datas
    'comme je ne savais pas si tu récupères les codes un à un ou en lot (dans un fichier par exemple),
    'je suis parti du principe qu'il pouvait y avoir plusieurs matches
    Set matches = regex.Execute(code)
    
    For Each Match In matches
        'pour chaque match, on récupère les groupes
        For i = 0 To Match.SubMatches.Count - 1
            capture = Match.SubMatches.Item(i)
            'on extrait la balise pour affecter le résultat comme il faut
            balise = Left(capture, 2)
            'j'ai choisi un select case, car ça se prête bien à la situation
            Select Case balise
                Case "01"
                    gtin = Right(capture, 14)
                    resultat = "(01)" + gtin
            
                Case "11"
                    dateProd = Right(capture, 6)
                    resultat = resultat + "(11)" + dateProd
                    
                Case "17"
                    dateExpi = Right(capture, 6)
                    resultat = resultat + "(17)" + dateExpi
                    
                Case "10"
                    numLot = Right(capture, Len(capture) - 2)
                    resultat = resultat + "(10)" + numLot
                    
                Case "21"
                    numSerie = Right(capture, Len(capture) - 2)
                    resultat = resultat + "(21)" + numSerie
            End Select
        Next
        'on écrit le résultat complet
        resultat = resultat + vbCrLf + "(01) GTIN de l’article: " + gtin + vbCrLf + "(11) Date de production: " + dateProd + vbCrLf + "(17) Date d'expiration : " + dateExpi + vbCrLf + "(10) Numéro de lot: " + numLot + vbCrLf + "(21) Numéro de série: " + numSerie
    Next
End If
TestNeriXs = resultat
End Function

Et dans le bouton

Private Sub BTDecod_Click()
    TxtAllData.Value = TestNeriXs(TxTCodeBarres.Value)
End Sub

TxTCodeBarres doit avoir la propriété multiline à true

NeriXs · Answer

Pour incrémenter les TextBox(s) de mon UserForm j'ai modifié le code de cette façon:

Option Explicit

Function TestNeriXs(code As String) As String
Dim pattern01, pattern11, pattern17, pattern10, pattern21, pattern, capture, balise, resultat, gtin, dateProd, dateExpi, numLot, numSerie As String
Dim regex, matches, Match As Object
Dim i As Integer

Set regex = New RegExp

'écriture des patterns unitaires
'Commençant avec la balise 01
'pattern01 = "^(01.{14})"
'Commençant éventuellement par un FNC1 (]C1, ]e0, ]d2, ]Q3, ]J1).
pattern01 = "^(?:](?:C1|e0|d2|Q3|J1))?(01.{14})"
pattern11 = "(11\d{6})"
pattern17 = "(17\d{6})"
'pattern10 = "(10.{1,20}?)(?:GS|$)"
pattern10 = "(10.{1,20}?)(?:GS|$|\x1d)"
'pattern21 = "(21.{1,20}?)(?:GS|$)"
pattern21 = "(21.{1,20}?)(?:GS|$|\x1d)"

'fusion du pattern complet
pattern = pattern01 + "(?:" + pattern11 + "|" + pattern17 + "|" + pattern10 + "|" + pattern21 + ")+$"

regex.pattern = pattern

'valeur par défaut si la regex ne matche pas
resultat = "Code incorrect"

'on vérifie d'abord que la regex matche
If (regex.test(code)) Then
    'si oui, on recoupère les datas
    Set matches = regex.Execute(code)
    
    For Each Match In matches
        'pour chaque match, on récupère les groupes
        For i = 0 To Match.SubMatches.Count - 1
            capture = Match.SubMatches.Item(i)
            'on extrait la balise pour affecter le résultat comme il faut
            balise = Left(capture, 2)
            'j'ai choisi un select case, car ça se prête bien à la situation
            Select Case balise
                Case "01"
                    gtin = Right(capture, 14)
                    resultat = "(01)" + gtin
            
                Case "11"
                    dateProd = Right(capture, 6)
                    resultat = resultat + "(11)" + dateProd
                    
                Case "17"
                    dateExpi = Right(capture, 6)
                    resultat = resultat + "(17)" + dateExpi
                    
                Case "10"
                    numLot = Right(capture, Len(capture) - 2)
                    resultat = resultat + "(10)" + numLot
                    
                Case "21"
                    numSerie = Right(capture, Len(capture) - 2)
                    resultat = resultat + "(21)" + numSerie
            End Select
        Next
        'on écrit le résultat complet
        FrmInterface.TxtAllData = resultat
        'Résultat détaillé pour chaque balise.
        FrmInterface.TxtGtinData = gtin
        FrmInterface.TxtProducData = dateProd
        FrmInterface.TxtExpirData = dateExpi
        FrmInterface.TxtLotData = numLot
        FrmInterface.TxtSnData = numSerie
    Next
End If
TestNeriXs = resultat
End Function

Le bouton:

Private Sub BTDecod_Click()

TxtAllData.Value = TestNeriXs(TxtCodeBarres.Value)

End Sub

Pourais-tu valider cette modification?

Comment gérerais-tu le fait qu'une balise n'est pas présente dans le code-barres et afficher " Pas d'information"?

Whismeril · Answer

Puisque tu as écrit cette ligne

'on écrit le résultat complet
        FrmInterface.TxtAllData = resultat

Pas besoin d'affecter à nouveau TxtAllData dans le bouton.

Attention cependant à la mauvaise pratique d'affecter un texte à une textbox.

Il y a une conversion implicite derrière, l'interprèteur se dit "ha il veut en fait affecter la propriété Value" ce qui est souvent le cas. Mais on pourrait imaginer des cas où ce ne serait pas ce que tu cherches à faire.

Le mieux est de s'astreindre à utiliser la bonne propriété.

Voire, encore mieux, activer Option Strict.

D'autant que cette conversion implicite n'existe pas pour tous les VB et si un jour tu changes c'est mieux d'avoir déjà la bonne pratique.

NeriXs · Answer

Bonjour,

J'ai des codes-barres ou il y a une balise GS a chaque fin de balise.

Sauf si dernière.

01 => GS
11 => GS
17 => GS
10 => GS
21 => GS

Exemple:
0100843997013703GS11210601GS213000105704

Je pensais utiliser (?:<GS>|$) à la fin de chaque pattern, mais ça match que pour ce code!
Les autres ne match plus!

Je remets les patterns ici:

pattern01 = "^(?:](?:C1|e0|d2|Q3|J1))?(01.{14})"
pattern11 = "(11\d{6})"
pattern17 = "(17\d{6})"
pattern10 = "(10.{1,20}?)(?:GS|$)"
pattern21 = "(21.{1,20}?)(?:GS|$)"

Whismeril · Answer

Ajouter (?:GS|$) à la fin de chaque pattern, veut dire qu'il faut obligatoirement GS ou fin de ligne. Or ça n'est pas le cas, il peut n'y avoir ni l'un ni l'autre.

A priori, je dirais qu'il faut juste ajouter, "il peut y avoir GS ou pas" => (?:GS)? puisque les seules balises où c'est obligatoirement GS ou fin de ligne c'est 10 et 21 car on ne sait pas à l'avance le nombre de caractères qui suivent.

Sauf si quand il y a GS pour 01, 11 ou 17, le nombre de caractères peut varier.

NeriXs · Answer

OK pour GS ou pas => (?:GS)?, ça match.
Merci

Je pensais avoir fait le tour, mais un nouveau cas de figure!

Pas de balises, mais les parenthèses directement dans le code-barres.

En scannant le code-barres j'ai directement:
(01)00843997013703(11)210601(17)230601(21)3000105704

Dans ce cas je dois ignorer la partie RegEx et directement avec LA condition qui va bien alimenter mes TextBox.

Depuis le code actuel, je ne vois trop où et comment gérer LA condition du Code-Barres qui possède déjà les parenthèses.

Whismeril · Answer

Bonjour

en supposant que les GS soit aussi présents quand les balises 10 et 21 sont au milieu (ce qu'on ne peut pas savoir avec ton exemple)

'écriture des patterns unitaires
pattern01 = "^(?:](?:C1|e0|d2|Q3|J1))?($?01$?.{14})(?:GS|\x1d)?"
pattern11 = "($?11$?\d{6})(?:GS|\x1d)?"
pattern17 = "($?17$?\d{6})(?:GS|\x1d)?"
pattern10 = "($?10$?.{1,20}?)(?:GS|$|\x1d)"
pattern21 = "($?21$?.{1,20}?)(?:GS|$|\x1d)"

Dans l'absolue, ça matchera avec une seule parenthèse sur les 2. On peut faire en sorte que ça ne soit pas le cas

NeriXs · Answer

J'essaie de comprendre pourquoi mais, cher moi le code-barres (l'exemple) avec parenthèses ne match pas.

Whismeril · Answer

Ha parce que j'ai mal fait mon test.

Ça marche sur Regex101, mais pas sur VBA.

Et comme je ne trouve pas pourquoi, voilà une solution qui fonctionne, bien testée.

'écriture des patterns unitaires
pattern01 = "^(?:](?:C1|e0|d2|Q3|J1))?(01.{14})(?:GS|\x1d)?"
pattern11 = "(11\d{6})(?:GS|\x1d)?"
pattern17 = "(17\d{6})(?:GS|\x1d)?"
pattern10 = "(10.{1,20}?)(?:GS|$|\x1d)"
pattern21 = "(21.{1,20}?)(?:GS|$|\x1d)"
code = Replace(Replace(code, "(", ""), ")", "")

NeriXs · Answer

Test 1
(01)00843997013703(11)210601(17)230601(21)3000105704
Match OK

Test 2
(01)00843997013703(11)210601(17)230601(10)54gp75P(21)3000105704
Patch partiel, Balise 21 non reconnu, donne:
(01)00843997013703(11)210601(17)230601(10)54gp75P213000105704

Test 3
(01)00843997013703(11)210601(10)54gp75P(17)230601(21)3000105704
Ne matche pas du tout!

Test 4
010084399701370311210601213000105704
Match OK

Test 5
01034009353394921726013110371GS2196133094316289
Match OK

Test 6
0100843997013703GS11210601GS213000105704
Match OK

Test 8
]C10100883873867792112209271723092710220927GS21PC23713163
Match OK

Test 9
0100843997013703GS17220601GS11210601GS213000105704
Match OK

Test 10
01034009346722482110045423841916GS10X09897AGS17260430
Match OK

Whismeril · Answer

Ha, donc quand les parenthèses sont présentes, y'a pas les GS.

Donc la solution de les supprimer avant le test regex n'est pas bonne.

NeriXs · Answer

Désolé, nous ne nous somme pas compris!

Au poste 41, j'ai écris :
Pas de balises, mais les parenthèses directement dans le code-barres.

En réponse au poste 42, tu écris:
En supposant que les GS soit aussi présents quand les balises 10 et 21 sont au milieu.

Je suis passé à côté de ta réponse.

Donc effectivement, aucune balise GS quand les parenthèses des balises 01, 10, 11, 17 et 21 sont codées directement dans les codes-barres.

Whismeril · Answer

Ha quel idiot, ce n'est pas la regex qui ne marchait pas.

C'est le traitement que j'en faisais ensuite.

Function TestNeriXs(code As String) As String
Dim pattern01, pattern11, pattern17, pattern10, pattern21, pattern, capture, balise, resultat, gtin, dateProd, dateExpi, numLot, numSerie As String
Dim regex, matches, Match As Object
Dim i As Integer

Set regex = New RegExp

'écriture des patterns unitaires
pattern01 = "^(?:](?:C1|e0|d2|Q3|J1))?($?01$?.{14})(?:GS|\x1d)?"
pattern11 = "($?11$?\d{6})(?:GS|\x1d)?"
pattern17 = "($?17$?\d{6})(?:GS|\x1d)?"
pattern10 = "($?10$?.{1,20}?)(?:GS|$|\x1d|$)"
pattern21 = "(\(?21$?.{1,20}?)(?:GS|$|\x1d|\()"

'fusion du pattern complet
pattern = pattern01 + "(?:" + pattern11 + "|" + pattern17 + "|" + pattern10 + "|" + pattern21 + ")+$"

regex.pattern = pattern

'valeur par défaut si la regex ne matche pas
resultat = "Code incorrect"

'on vérifie d'abord que la regex matche
If (regex.Test(code)) Then
    'si oui, on recoupère les datas
    'comme je ne savais pas si tu récupères les codes un à un ou en lot (dans un fichier par exemple),
    'je suis parti du principe qu'il pouvait y avoir plusieurs matches
    Set matches = regex.Execute(code)
    
    For Each Match In matches
        'pour chaque match, on récupère les groupes
        For i = 0 To Match.SubMatches.Count - 1
            capture = Replace(Replace(Match.SubMatches.Item(i), "(", ""), ")", "")
                      
            balise = Left(capture, 2)
            'j'ai choisi un select case, car ça se prête bien à la situation
            Select Case balise
                Case "01"
                    gtin = Right(capture, 14)
                    resultat = "(01)" + gtin
            
                Case "11"
                    dateProd = Right(capture, 6)
                    resultat = resultat + "(11)" + dateProd
                    
                Case "17"
                    dateExpi = Right(capture, 6)
                    resultat = resultat + "(17)" + dateExpi
                    
                Case "10"
                    numLot = Right(capture, Len(capture) - 2)
                    resultat = resultat + "(10)" + numLot
                    
                Case "21"
                    numSerie = Right(capture, Len(capture) - 2)
                    resultat = resultat + "(21)" + numSerie
            End Select
        Next
        'on écrit le résultat complet
        resultat = resultat + vbCrLf + "(01) GTIN de l’article: " + gtin + vbCrLf + "(11) Date de production: " + dateProd + vbCrLf + "(17) Date d'expiration : " + dateExpi + vbCrLf + "(10) Numéro de lot: " + numLot + vbCrLf + "(21) Numéro de série: " + numSerie
    Next
End If
TestNeriXs = resultat
End Function

Avec ce code de test

codes = Array("(01)00843997013703(11)210601(17)230601(21)3000105704", "(01)00843997013703(11)210601(17)230601(10)54gp75P(21)3000105704", "(01)00843997013703(11)210601(10)54gp75P(17)230601(21)3000105704")

For Each code In codes
    Debug.Print (code)
    Debug.Print (TestNeriXs(CStr(code)))
    Debug.Print ("")
Next

J'obtiens

(01)00843997013703(11)210601(17)230601(21)3000105704
(01)00843997013703(11)210601(17)230601(21)3000105704
(01) GTIN de l’article: 00843997013703
(11) Date de production: 210601
(17) Date d'expiration : 230601
(10) Numéro de lot: 
(21) Numéro de série: 3000105704

(01)00843997013703(11)210601(17)230601(10)54gp75P(21)3000105704
(01)00843997013703(11)210601(17)230601(10)54gp75P(21)3000105704
(01) GTIN de l’article: 00843997013703
(11) Date de production: 210601
(17) Date d'expiration : 230601
(10) Numéro de lot: 54gp75P
(21) Numéro de série: 3000105704

(01)00843997013703(11)210601(10)54gp75P(17)230601(21)3000105704
(01)00843997013703(11)210601(17)230601(10)54gp75P(21)3000105704
(01) GTIN de l’article: 00843997013703
(11) Date de production: 210601
(17) Date d'expiration : 230601
(10) Numéro de lot: 54gp75P
(21) Numéro de série: 3000105704

NeriXs · Answer

HA!, très bonne nouvelle, ça match, match et re-match!.

Ce n'était pas si évident que ça! Merci

Au niveau du "décodage" des codes-barres, je pense qu'on doit avoir fait le tour.

Concernant le résultat, penses-tu qu'il soit possible de le mettre dans l'ordre d'origine ?

Exemple:

Code-barres scanné:
0107332414124359210000107668GS11210208

Résultat Excel VBA
(01)07332414124359(11)210208(21)0000107668

Ce qui est affiché sous le code-barres scanné:
(01)07332414124359(21)0000107668(11)210208

Vu que l'ordre semble aléatoire, ce n'est peut-être pas possible?

Whismeril · Answer

Bonsoir

c'est un peu chiant, dans le sens où VBA ne conserve pas la position de chaque capture dans la collection SubMatches.

J'ai donc utilisé un Dictionary (il faut ajouter Microsoft scripting dans les références) dont la clé est la position, convertie en string (la clé ne peut pas être un entier).

Ensuite, par incrément, je cherche la clé suivante.

Function TestNeriXs(code As String) As String
Dim pattern01, pattern11, pattern17, pattern10, pattern21, pattern, capture, balise, resultat, gtin, dateProd, dateExpi, numLot, numSerie As String
Dim regex, matches, Match, item As Object
Dim i, position As Integer
Dim mesItems As Dictionary

Set regex = New RegExp

'écriture des patterns unitaires
pattern01 = "^(?:](?:C1|e0|d2|Q3|J1))?($?01$?.{14})(?:GS|\x1d)?"
pattern11 = "($?11$?\d{6})(?:GS|\x1d)?"
pattern17 = "($?17$?\d{6})(?:GS|\x1d)?"
pattern10 = "($?10$?.{1,20}?)(?:GS|$|\x1d|$)"
pattern21 = "(\(?21$?.{1,20}?)(?:GS|$|\x1d|\()"

'fusion du pattern complet
pattern = pattern01 + "(?:" + pattern11 + "|" + pattern17 + "|" + pattern10 + "|" + pattern21 + ")+$"

regex.pattern = pattern

'valeur par défaut si la regex ne matche pas
resultat = "Code incorrect"

'on vérifie d'abord que la regex matche
If (regex.Test(code)) Then
    'si oui, on recoupère les datas
    'comme je ne savais pas si tu récupères les codes un à un ou en lot (dans un fichier par exemple),
    'je suis parti du principe qu'il pouvait y avoir plusieurs matches
    Set matches = regex.Execute(code)
    
    For Each Match In matches
        
        'Pour chaque match, on crée un dictionnaire dont la clé est la position dans le code initial et la valeur la captue, sans les GS et les (
        Set mesItems = New Dictionary
        
        'la première valeur est toujours 01
        mesItems.Add "01", Match.SubMatches.item(0)

'on ajoute les submatches 1 à n
        For i = 1 To Match.SubMatches.Count - 1
            position = InStr(code, Match.SubMatches.item(i))
            If position > 1 Then 'les groupes qui ne macthent rien sont vides et ça donne une position à 1
                mesItems.Add Format(position, "00"), Match.SubMatches.item(i)
            End If
        Next
        
        'on repart de la position 1
        i = 1
        Do
            'on vérifie que la clé existe
            Do While Not mesItems.Exists(Format(i, "00")) And i < Len(code)
                i = i + 1 'il faut incrémenter pour passer les GS et les ( qui ont été ignorés
            Loop
            
            capture = mesItems.item(Format(i, "00"))
            capture = Replace(Replace(capture, "(", ""), ")", "")
            
            i = i + Len(capture) 'on passe à la position suivante à partir de laquel il faut chercher une clé
            
            balise = Left(capture, 2)
            'j'ai choisi un select case, car ça se prête bien à la situation
            Select Case balise
                Case "01"
                    gtin = Right(capture, 14)
                    resultat = "(01)" + gtin
            
                Case "11"
                    dateProd = Right(capture, 6)
                    resultat = resultat + "(11)" + dateProd
                    
                Case "17"
                    dateExpi = Right(capture, 6)
                    resultat = resultat + "(17)" + dateExpi
                    
                Case "10"
                    numLot = Right(capture, Len(capture) - 2)
                    resultat = resultat + "(10)" + numLot
                    
                Case "21"
                    numSerie = Right(capture, Len(capture) - 2)
                    resultat = resultat + "(21)" + numSerie
            End Select
        Loop While i < Len(code) 'quand on a atteint la taille du code (pour GS...), c'est qu'on a fini
        
        'on écrit le résultat complet
        resultat = resultat + vbCrLf + "(01) GTIN de l’article: " + gtin + vbCrLf + "(11) Date de production: " + dateProd + vbCrLf + "(17) Date d'expiration : " + dateExpi + vbCrLf + "(10) Numéro de lot: " + numLot + vbCrLf + "(21) Numéro de série: " + numSerie
    Next
End If
TestNeriXs = resultat
End Function

Whismeril · Answer

Vu ton autre question, j'ai utilisé une classe. Il faut ajouter un module de classe, le renommer UnCode et copier coller ça dedans 'Champs utiles Public Capture As String Public Balise As String Public LeCode As String Public Position As Integer 'Initialise l'instance de l'objet UnCode Public Sub Init(LaCapture As String, LaPosition As Integer) Capture = Replace(Replace(LaCapture, "(", ""), ")", "") Position = LaPosition Balise = Left(Capture, 2) LeCode = Right(Capture, Len(Capture) - 2) End Sub 'Méthode qui retourne un texte sous la forme "(Balise)LeCode" Public Function Texte() As String Texte = "(" & Balise & ")" & LeCode End Function 'Méthode qui retourne un texte sous la forme "(Balise) Description : LeCode" Public Function Description() As String Dim madescription As String Select Case Balise Case "01" madescription = "(01) GTIN de l’article: " Case "11" madescription = "(11) Date de production: " Case "17" madescription = "(17) Date d'expiration : " Case "10" madescription = "(10) Numéro de lot: " Case "21" madescription = "(21) Numéro de série: " End Select Description = madescription + LeCode End Function Ensuite, il faut modifier la lecture comme ça Function TestNeriXs(code As String) As String Dim pattern01, pattern11, pattern17, pattern10, pattern21, pattern, ligne1, ligne2 As String Dim regex, matches, Match As Object Dim i, Position As Integer Dim resultats As Dictionary Dim unCode As unCode Set regex = New RegExp 'écriture des patterns unitaires pattern01 = "^(?:](?:C1|e0|d2|Q3|J1))?($?01$?.{14})(?:GS|\x1d)?" pattern11 = "($?11$?\d{6})(?:GS|\x1d)?" pattern17 = "($?17$?\d{6})(?:GS|\x1d)?" pattern10 = "($?10$?.{1,20}?)(?:GS|$|\x1d|$)" pattern21 = "(\(?21$?.{1,20}?)(?:GS|$|\x1d|\()" 'fusion du pattern complet pattern = pattern01 + "(?:" + pattern11 + "|" + pattern17 + "|" + pattern10 + "|" + pattern21 + ")+$" regex.pattern = pattern 'valeur par défaut si la regex ne matche pas ligne1 = "Code incorrect" 'on vérifie d'abord que la regex matche If (regex.test(code)) Then 'si oui, on recoupère les datas 'comme je ne savais pas si tu récupères les codes un à un ou en lot (dans un fichier par exemple), 'je suis parti du principe qu'il pouvait y avoir plusieurs matches Set matches = regex.Execute(code) For Each Match In matches ligne1 = "" ligne2 = "" Set resultats = New Dictionary Set unCode = New unCode unCode.Init Match.SubMatches.item(0), 1 resultats.Add "01", unCode 'on ajoute les submatches 1 à n For i = 1 To Match.SubMatches.Count - 1 Position = InStr(code, Match.SubMatches.item(i)) If Position > 1 Then 'les groupes qui ne macthent rien sont vides et ça donne une position à 1 Set unCode = New unCode unCode.Init Match.SubMatches.item(i), Position resultats.Add Format(Position, "00"), unCode End If Next 'on repart de la position 1 i = 1 Do Set unCode = resultats.item(Format(i, "00")) 'la ligne1 est la reconstitution du code avec les parenthèses, la ligne2 les descriptions ligne1 = ligne1 + unCode.Texte() ligne2 = ligne2 + vbCrLf + unCode.Description() i = i + Len(unCode.Capture) 'on passe à la position suivante à partir de laquel il faut chercher une clé 'on vérifie que la clésuivante existe Do While Not resultats.Exists(Format(i, "00")) And i < Len(code) i = i + 1 'il faut incrémenter pour passer les GS et les ( qui ont été ignorés Loop Loop While i < Len(code) 'quand on a atteint la taille du code (pour GS...), c'est qu'on a fini Next End If TestNeriXs = ligne1 + ligne2 End Function Avec ce code de test Sub test() Dim codes, code As Variant codes = Array("0107332414124359210000107668GS11210208", "(01)00843997013703(11)210601(17)230601(21)3000105704", "(01)00843997013703(11)210601(17)230601(10)54gp75P(21)3000105704", "(01)00843997013703(11)210601(10)54gp75P(17)230601(21)3000105704") For Each code In codes Debug.Print (code + " => ") Debug.Print (TestNeriXs(CStr(code))) Debug.Print ("") Next End Sub J'obtiens 0107332414124359210000107668GS11210208 => (01)07332414124359(21)0000107668(11)210208 (01) GTIN de l’article: 07332414124359 (21) Numéro de série: 0000107668 (11) Date de production: 210208 (01)00843997013703(11)210601(17)230601(21)3000105704 => (01)00843997013703(11)210601(17)230601(21)3000105704 (01) GTIN de l’article: 00843997013703 (11) Date de production: 210601 (17) Date d'expiration : 230601 (21) Numéro de série: 3000105704 (01)00843997013703(11)210601(17)230601(10)54gp75P(21)3000105704 => (01)00843997013703(11)210601(17)230601(10)54gp75P(21)3000105704 (01) GTIN de l’article: 00843997013703 (11) Date de production: 210601 (17) Date d'expiration : 230601 (10) Numéro de lot: 54gp75P (21) Numéro de série: 3000105704 (01)00843997013703(11)210601(10)54gp75P(17)230601(21)3000105704 => (01)00843997013703(11)210601(10)54gp75P(17)230601(21)3000105704 (01) GTIN de l’article: 00843997013703 (11) Date de production: 210601 (10) Numéro de lot: 54gp75P (17) Date d'expiration : 230601 (21) Numéro de série: 3000105704

NeriXs · Answer

Ça fonctionne très bien et en plus j'apprends, merci

Le fait de gérer les patterns individuellement me facilite grandement la tâches pour la finalisation du projet.

Je fais face à une problématique et ne suis pas sûr qu'il y ai une solution!

Le plus souvent les codes-barres utilisent des balises de 2 caractères.
Dans quelques cas, des balises de 3 ou 4 caractères sont utilisés.

J'ai trouvé la liste complète des " Application Identifiers (AI)" que nous avons appelé balises.
https://www.gs1.org/standards/barcodes/application-identifiers

La taille de ces AI est connue, sauf pour ceux variables, c'est ce qui me fait peur!

Voix tu une possibilité de gérer cette nouvelle difficulté?

Whismeril · Answer

OK.

mais selon ta première page, il y a plus de 500 cas à traiter.

Une seule regex n'y arrivera pas. C'est très puissant mais ça a ses limites.

En plus les regex présentées considèrent que le code est déjà découpé, puisque chacune teste le texte entier.

Est ce que tu tombes souvent sur des cas qui sortent de ce qu'on a déjà fait?

Si oui est avec quelques balises identiques ou totalement aléatoires dans les 500 et quelques ?

NeriXs · Answer

Pour répondre aux questions:

Est-ce que tu tombes souvent sur des cas qui sortent de ce qu'on a déjà fait?

Ce n'était pas le cas jusqu’à peu, j'exploitais seulement les balises "AI" 01, 10, 11, 17 et 21, soit EAN-128.
Une nouvelle directive du début du mois, concernant ma GMAO m'impose d'utiliser les codes UDI "Identifiant unique des dispositifs (IUD)" le GS1-128.

Si oui est avec quelques balises identiques ou totalement aléatoires dans les 500 et quelques ?

Depuis la Fin de semaine dernière ou j'ai commencé à scanner ces Codes-barres UDI, j'ai rencontré en plus des balises "AI" habituel les balises suivantes:
8013, 421, 241, 253, 90, 91, 37, 24, 42

J'ai aucun doute que d'autres vont arriver vu le nombre de prestataires!

Le problème est que si une des 519 balises est dans un de mes codes-barres je ne pourrais récupérer aucune info "Code Incorrect".

L'avantage de toutes les générer, même avec  nom bidon, le jour ou une d'elles est nécessaire elles sont là!

Peut-être une idée:

En supposant qu'on puisse faire prendre en charge plusieurs balises sur un Pattern!

Exemple avec balises fictives:
3 balises: 54, 78, 103

En reprenant le Pattern 17 qu'on utilise déjà + les 3 balises et le OU (|):

"($?17$?\d{6}) | ($?54$?\d{6}) | ($?78$?\d{6}) | ($?103$?\d{6})(?:GS|\x1d)?"

Ça semble fonctionner, mais il a peut-être plus simple.

Dans ce sens, j'ai pu faire 54 groupes de balises qui utilisent le même Pattern:

Soit un Pattern par groupe.

La convention suivante est appliquée :
 
N = chiffre numérique
X = tout caractère
N3 = 3 chiffres, longueur fixe
N..3 = jusqu'à 3 chiffres numériques
X..3 = jusqu'à 3 caractères

Idem pour 2 et 4

Ou X = balises multiples.

Format => Nombre d'utilisation => Balise(s) concernée(s) => Balise de fin requise "GS" => Pattern

1)    N2+N18 => 1 => 00 => Non => ^0(\d{18})$

2)    N2+N14 => 2 => 01, 02 => Non => ^X(\d{14})$

3)    N2+X..20 => 3 => 10, 21, 22 => Oui => ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,20})$

4)    N2+N6 => 6 => 11, 12, 13, 15, 16, 17 => Non => ^X(\d{6})$

5)    N2+N2 => 1 => 20 => Non => ^20(\d{2})$

6)    N3+X..28 => 1 => 235 => Oui => ^235([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,28})$

7)    N3+X..30 => 7 => 240, 241, 250, 251, 400, 401, 403 => Oui => ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,30})$

8)    N3+N..6 => 1 => 242 => Oui => ^242(\d{0,6})$

9)    N3+X..20 => 9 => 243, 254, 420, 710, 711, 712, 713, 714, 715 => Oui =>     ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,20})$

10)    N3+N13[+X..17] => 1 => 253 => Oui => ^253(\d{13})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,17})$

11)    N3+N13[+N..12] => 1 =>255 => Oui => ^255(\d{13})(\d{0,12})$

12)    N2+N..8 => 2 => 30, 37 => Oui => ^X(\d{0,8})$

13)    N4+N6 => 331 => 3100 à 3105, 3110 à 3115, 3120 à 3125, 3130 à 3135, 3140 à 3145, 3150 à 3155, 3160 à 3165,
 
    3200 à 3205, 3210 à 3215, 3220 à 3225, 3230 à 3235, 3240 à 3245, 3250 à 3255, 3260 à 3265, 3270 à 3275, 3280 à 3285, 3290 à 3295,
 
    3300 à 3305, 3310 à 3315, 3320 à 3325, 3330 à 335, 3340 à 3345, 3350 à 3355, 3360 à 3365, 3370 à 3375,

3400 à 3405, 3410 à 3415, 3420 à 3425, 3430 à 3435, 3440 à 3445, 3450 à 3455, 3460 à 3465, 3470 à 3475, 3480 à 3485, 3490 à 3495,

3500 à 3505, 3510 à 3515, 3520 à 3525, 3530 à 3535, 3540 à 3545, 3550 à 3555, 3560 à 3565, 3570 à 3575,

3600 à 3605, 3610 à 3615, 3620 à 3625, 3630 à 3635, 3640 à 3645, 3650 à 3655, 3660 à 3665, 3670 à 3675, 3680 à 3685, 3690 à 3695,

3950 à 3959,

4326, 7006, 8005 => Oui => ^X(\d{6})$
 
14)    N4+N6..12 => 1 => 7007 => Oui => ^7007(\d{6,12})$

15)    N4+N6[+N..4] => 1 => 7011 => Oui => ^7011(\d{6})(\d{0,4})$

16)    N4+N..15 => 20 => 3900 à 3909, 3920 à 3929 => Oui => ^X(\d{0,15})$
 
17)    N4+N3+N..15 => 20 => 3910 à 3919, 3930 à 3939 => Oui => ^X(\d{3})(\d{0,15})$

18)    N4+N4 => 5 => 3940 à 3943, 8111 => Oui => ^X(\d{4})$

19)    N3+N17 => 1 => 402 => Oui => ^402(\d{17})$

20)    N3+N13 => 8 => 411 à 417 => Non => ^X(\d{13})$

21)    N3+N3+X..9 => 1 => 421 => Oui => ^421(\d{3})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,9})$

22)    N3+N3 => 3 => 422, 424, 426 => Oui => ^X(\d{3})$

23)    N3+N3+N..12 => 2 => 423, 425 => Oui => ^X(\d{3})(\d{0,12})$

24)    N3+X..3 => 1 => 427 => Oui => ^427([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,3})$

25)    N4+X..35 => 5 => 4300, 4301, 4310, 4311, 4320 => Oui => ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,35})$

26)    N4+X..70 => 13 => 4302 à 4306, 4312 à 4316, 8110, 8112, 8200 => Oui => ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,70})$

27)    N4+X2 => 2 => 4307, 4317 => Oui => ^X([A-Z]{2})$

28)    N4+X2+X..28 => 10 => 7230 à 7239 => Oui => ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{2,30})$

29)    N4+X..30 => 5 => 4308, 4319, 7002, 7023, 8004 => Oui => ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,30})$

30)    N4+N20 => 1 => 4308 => Oui => ^4309(\d{20})$

31)    N4+X..20 => 7 => 4318, 7020, 7021, 7022, 7240, 8002, 8012 => Oui => ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,20})$

32)    N4+N1 => 3 => 4321, 4322, 4323 => Oui => ^X([01])$

33)    N4+N10 => 3 =>4324, 4325, 7003 => Oui => ^X(\d{10})$

34)    N4+N13 => 1 => 7001 => Oui => ^7001(\d{13})$

35)    N3+N13 => 8 => 410 à 417 => Non => ^X(\d{13})$

36)    N4+X..12 => 1 => 7005 => Oui => ^7005([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,12})$

37)    N4+X..3 => 1 => 7008 => Oui => ^7008([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,3})$

38)    N4+N14+N2+N2 => 2 => 8006, 8026 => Oui => ^X(\d{14})(\d{2})(\d{2})$

39)    N4+X..34 => 1 => 8007 => Oui => ^8007([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,34})$

40)    N4+N8[+N..4] => 1 => 8008 => Oui => ^8008(\d{8})(\d{0,4})$

41)    N4+X..50 => 1 => 8009 => Oui => ^8009([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,50})$

42)    N4+Y..30 => 1 => 8010 => Oui => ^8010([\x23\x2D\x2F\x30-\x39\x41-\x5A]{5,30})$

43)    N4+X..10 => 1 => 7009 => Oui => ^7009([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,10})$

44)    N4+X..2 => 1 => 7010 => Oui => ^7010([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,2})$

45)    N4+N1+X3 => 1 => 7040 => Oui => ^7040(\d[\x21-\x22\x25-\x2F\x30-\x39\x41-\x5A\x5F\x61-\x7A]{3})$

46)    N4+N..12 => 1 => 8011 => Oui => ^8011(\d{0,12})$

47)    N4+N3+X..27 => 10 => 7030 à 7039 => Oui => ^X(\d{3})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,27})$

48)    N4+N14 => 1 => 8001 => Oui => ^8001(\d{14})$

49)    N4+N14+X..16 => 1 => 8003 => Oui => ^8003(\d{14})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,16})$

50)    N4+X..25 => 2 => 8013, 8020 => Oui => ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,25})$

51)    N4+N18 => 2 => 8017, 8018 => Oui => ^X(\d{18})$

52)    N4+N..10 => 1 => 8019 => Oui => ^8019(\d{0,10})$

53)    N2+X..30 => 1 => 90 => Oui => ^90([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,30})$

54)    N2+X..90 => 9 => 91 à 99 => Oui => ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,90})$

-------------------------------------------------------------------------------------------------------------

Le groupe 13 couvre 331 balises et certains groupes en couvre qu'une!

Whismeril · Answer

Oui mais toute ces regex partent du principe que les groupes sont déja découpées....

NeriXs · Answer

En s'inspirant du modèle:

pattern21 = "($?21$?.{0,90}?)(?:GS|$|\x1d|$)"

Pour nouvelle la Balise 91, en adaptant les critères de recherche SG1:

pattern91= "(\(?91$?.[\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,90}?)(?:GS|$|\x1d|$)"

Jusque-là c'est OK.

Pour les Balises 91 à 99 quelque chose comme ce qui suit pourrait marcher?

Balises9X = Array("91", "92", "93", "94", "95", "96", "97", "98", "99")
pattern9X= "(\(?)"+Balises9X+"($?.[\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,90}?)(?:GS|$|\x1d|\()"

NeriXs · Answer

Je ne sais pas si c'est un problème avec la fonction:

Public Function Description() As String
    Dim madescription As String
    
    Select Case Balise
        Case "01"
            madescription = "(01) GTIN de l’article: "
    
        Case "11"
            madescription = "(11) Date de production: "
            
        Case "17"
            madescription = "(17) Date d'expiration : "
            
        Case "10"
            madescription = "(10) Numéro de lot: "
            
        Case "21"
            madescription = "(21) Numéro de série: "

Case "91"
            madescription = "(91) InfosInternes: "
        
    End Select
           
    Description = madescription + LeCode
End Function

Case "91" ne s'affiche pas!

Testé avec:

010088483808258821DE7840AL79<GS>91867031

Whismeril · Answer

Déjà, on n'a jamais pris en compte les chevrons, pour l'instant, je les ai enlevés du code.

Ensuite, y'a une garouille avec les parenthèses.

Et puis, sur la 21eme page de codes GS1, dans les regex 9x, y'a pas le . avant le [

"($?9[1-9]$?)([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,90}?)(?:GS|$|\x1d|\()"

Et une fois tout ça corrigé, il me matche la balise 91 et une 86, alors que je n'ai pas codé de pattern qui cherche 86....

010088483808258821DE7840AL79GS91867031
(01)00884838082588(21)DE7840AL79(91)(86)7031
(01) GTIN de l’article: 00884838082588
(21) Numéro de série: DE7840AL79

7031

Y'a forcément encore un truc qui m'échappe....

NeriXs · Answer

C'est OK, ça match, bien joué!

Non les chevrons autour de GS ne sont pas à prendre en compte, Désolé.

Je ne parviens pas à faire prendre en charge les balises de 3 ou 4 caractères en plus des balises de 2 caractères.

Pourrais-tu regarder?

Whismeril · Answer

J'avais laissé passer une coquille pour les tests

"($?9[1-9]$?[\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,90}?)(?:GS|$|\x1d|\()"

Avant de regarder les 3 ou 4 caractères, je vais essayer de rationaliser un peu.

Par exemple, la liste de code hexa là, n'est pas optimisée.

Whismeril · Answer

Déjà,

dans la liste, on constate que beaucoup de parties (celles à taille variable) requièrent une fin, soit le texte GS, soit le caractère GS, soit une parenthèse, soit la fin du texte.

Et celles qui sont à taille fixe peuvent quand même rencontrer un GS ou un GS.

On peut commencer par ça

'écriture des patterns unitaires
gs = "(?:GS|\x1d)?" 'quand c'est peut-être
fnc1 = "(?:GS|$|\x1d|$)" 'quand c'est obligé
pattern01 = "^(?:](?:C1|e0|d2|Q3|J1))?(\(?01$?.{14})" + gs
pattern11 = "($?11$?\d{6})" + gs
pattern17 = "($?17$?\d{6})" + gs
pattern10 = "($?10$?.{1,20}?)" + fnc1
pattern21 = "($?21$?.{1,20}?)" + fnc1

Ensuite, à l'instar des 9X, les 1x pourraient devenir

pattern1X = "($?1[1-35-7]$?\d{6})" + gs

Mais, ça ne marche pas. S'il y a un 11 et un 17, ça matche, mais ensuite seul le 2eme est pris en compte.

Quand on regarde avec regex101, on voit qu'il y a des submatches de submatches. En .Net, je sais gérer ça, en VBA, j'ai pas encore trouvé, et le problème va se poser aussi, si tu as plusieurs 9X

Ensuite, pour les patterns 10 et 21 nous on a mis un .{1,20}, mais dans le tableau c'est la même liste de caractères que pour les 9x (liste pas optimisée non plus) et ils ont mis {0, 20}, ce qui veut dire que tu pourrais avoir la balise sans info derrière.

NeriXs · Answer

Le GS texte, c'est moi qui l'ai imposé pour tester sans lecteur de code-barres.

\x1d, c'est depuis le lecteur de code-barres.

Pour les 1x, je n'ai pas compris ton pattern.

pattern1X = "($?1[1-35-7]$?\d{6})" + gs

1[1-35-7] = 11 ou 135 ou 17 ?
1[1-35-7] = 11 à 135 et 135 à 17 ?

J'ai donné le nom de 9X pour les balises du groupe 54) de 91 à 99 qui ont le même pattern, 90 ayant un pattern différant.

On peut utiliser 1X pour le groupe 4), soient les balises 11, 12, 13, 15, 16, 17 qui ont elles aussi le même pattern.

Il est peut-être plus judicieux de nommer les pattern par groupe

G= groupe

Soit:

patternG1 à patternG54, même si certains groupes n'ont qu'une seule balise.
Voir ma réponse https://codes-sources.commentcamarche.net/forum/affich-10112115-regex-recherche-patten-de-capture-un-defi?page=3#p10112220

Whismeril · Answer

Pour illustrer plus clairement mon propos.

Voici un premier exemple, c'est notre pattern avec un de tes codes (avec des parenthèses pour que ce soit plus lisible) et les AI 11 et 17

https://regex101.com/r/3Mmy10/1

Dans l'encart Match Information, on voit que la regex capture bien le texte entier, mais que le groupe 2 c'est (17).... et du coup (11)... est ignoré.

Dans ce second exemple, j'ai juste changé de moteur, j'ai pris celui de .Net

https://regex101.com/r/3Mmy10/2

Là, on voit un groupe 2.1 qui est (11)... et un groupe 2.2 (17)...

VBA se comporte comme l'exemple 1, mais pour rationaliser (notamment pouvoir utiliser le pattern 9X et le 1X), il faudrait obtenir un comportement comme en .Net.

J'ai une idée mais j'ai pas le temps de tester maintenant.

NeriXs · Answer

J'ai porté le tableau des 54 groupes de patterns sur Excel, si ça peut aider!

Groupes de Patterns

Whismeril · Answer

Si mon idée fonctionne, ça aidera

Whismeril · Answer

Bon,

je fais 2 pas en avant et 1 en arrière.

J'arrive à trouver les AI 11 et 17 avec un seul pattern qui matche 11, 12, 13, 15, 16 et 17.

Mais la façon de faire, trouve aussi 2 AI 21 là où il n.y en a qu'une.

Je suis sur une piste, mais ça devient une usine à gaz.

VBA c'est dans ton cahier des charges ou c'est parce que tu connais mieux qu'autre chose?

NeriXs · Answer

Je n'ai pas de cahier des charges particulier, mais plutôt des contraintes.

Je suis certes un peu plus à mon aise avec VBA est nos machines possèdent toutes Excel.

Les contraintes:

Le projet doit être facilement porté sur l'un des 4 postes informatique de notre service.

Le projet ne doit pas avoir recours à des solutions qui requièrent des licences que ces 4 postes informatiques ne possèdes déjà.

Je dois pouvoir le modifier en cas de besoin.

J'ai pensé à PHP, mais je n'ai jamais utilisé autre choses que des solutions clé en main, type serveur Wamp (pas sûr que notre service info nous l'autorise).

Si tu voix d'autres possibilités, je suis ouvert à tout!

Le but de ce projet et vraiment de nous faciliter le quotidien, la saisie manuelle de ces codes est fastidieuse et source d'erreurs.

Whismeril · Answer

Sauf que dans les exemples que j'ai mis en #71 j'ai essayé tous les moteurs proposés.

Il semble que seul .Net permet de récupérer plusieurs submatches d'un même groupe.

J'ai fait un test avec Python, et effectivement apparemment, on ne peut pas.

Pour .Net, Visual Studio Community est gratuit sous conditions, ces conditions autorisent les petites sociétés (faut donc aller les lire..)

Le langage "pur .Net" c'est C#, (un descendant de C/C++ et Java), il y a aussi VB.Net (attention, faux ami de VBA lire ceci)

Je vais faire un test en .Net et je te le poste

NeriXs · Answer

Dans ton exemple tu utilises:

($?9[1-9]$?[\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,90})(?:GS|$|\x1d|$))+$

Soit un pattern multiple pour 91 à 99

Je faisais allusion a l'utilisation de patterns individuel comme :

"(\(?91$?.[\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,90}?)(?:GS|$|\x1d|\()"

Concernant ces balises 9X pour le moment je n'ai rencontré que 91 et 93.

NeriXs · Answer

Je pense que tu as commenté ton dernier poste juste avant ma réponse ?

NeriXs · Answer

Si tu le veux bien, avant d'envisager une autre solution ou je ne suis vraiment pas à l'aise, j'aimerais tester les patterns individuels sous VBA comme on l'a fait jusqu’à présent.
Dans ce sens, pourrais du juste ajouter la prise en charge des balises de 3 et 4 caractères?
Partir du code ou tu as ajouté la classe, celui-ci : #52

Whismeril · Answer

Je ne peux pas passer encore des heures pour quelque chose qui ne mènera à rien.

Y'a pas 36 solutions soit on trouve une méthode qui découpe le code en parties que tu peux ensuite tester avec les regex telles que tu souhaites les regrouper ( mais je pressens que si on y arrive, c'est qu'on aura fait autrement et que les regex ne seront plus utiles).

Par exemple https://regex101.com/r/R4TIg3/1 ce cas te montre que le pattern 21 peut matcher la mauvaise partie du code s'il est seul

Ce second exemple type 2x, matche n'importe quoi.

Soit il faudra une regex avec les 500 cas et là, à mon avis elle ne fonctionnera car trop complexe, déjà que les 50 et quelques groupes, j'ai un doute, 500, c'est quasiment sûr c'est trop.

Pour moi à ce stade, s'embarquer dans les AI à 3 chiffres ne sert à rien tant qu'on a pas résolu le problème des patterns regroupés.

Whismeril · Answer

Je crois que pour les patterns regroupés, j'y suis.

La classe modifiée comme suit

'Champs utiles
Public AI As String

Public Code As String

'Initialise l'instance de l'objet UnCode
Public Sub Init(LaBalise As String, LeCode As String)
    AI = LaBalise
    Code = LeCode
End Sub

'Méthode qui retourne un texte sous la forme "(Balise)LeCode"
Public Function Texte() As String
    Texte = "(" & AI & ")" & Code
End Function

'Méthode qui retourne un texte sous la forme "(Balise) Description : LeCode"
Public Function Description() As String
    Dim madescription As String
    
    Select Case AI
        Case "01"
            madescription = "(01) GTIN de l’article: "
    
        Case "11"
            madescription = "(11) Date de production: "
            
        Case "17"
            madescription = "(17) Date d'expiration : "
            
        Case "10"
            madescription = "(10) Numéro de lot: "
            
        Case "21"
            madescription = "(21) Numéro de série: "
        
        Case "91"
            madescription = "(91) InfosInternes: "
            
    End Select
           
    Description = madescription + Code
End Function

Le code de déchiffrement comme suit

Function TestNeriXs4(Code As String) As String
Dim fnc1, gs, caracteresOK, pattern, ligne1, ligne2 As String
Dim regex, Match As Object
Dim i As Integer
Dim resultats As Collection
Dim unCode As unCode
Dim patterns As Variant
Dim boucleOut As Boolean

Set regex = New RegExp

'écriture des patterns unitaires
gs = "(\x1d|$)?" 'quand c'est peut-être
fnc1 = "(\x1d|$|\()" 'quand c'est obligé
caracteresOK = "[\x21-\x22\x25-\x3F\x41-\x5A\x5F\x61-\x7A]"

'on met les patterns unitaires dans un tableau
patterns = Array("(?:](?:C1|e0|d2|Q3|J1))?\(?(01)$?(" + caracteresOK + "{14})" + gs, _
            "$?(1[123567])$?(\d{6})" + gs, _
            "$?(10)$?(" + caracteresOK + "{1,20}?)" + fnc1, _
            "$?(21)$?(" + caracteresOK + "{1,20}?)" + fnc1 _
            )
'"($?9[1-9]$?" + caracteresOK + "{0,90})" + fnc1 _

'valeur par défaut si la regex ne matche pas
ligne1 = "Code incorrect"
ligne2 = ""
Set resultats = New Collection

Do
    boucleOut = False
    For Each pattern In patterns
        'on teste chaque pattern pour le début du code
        regex.pattern = "^" + pattern
        If (regex.Test(Code)) Then
            boucleOut = True
            ligne1 = ""
            'si ça marche, on extrait la partie
            Set Match = regex.Execute(Code)(0)
    
            Set unCode = New unCode
            unCode.Init Match.SubMatches(0), Match.SubMatches(1)
            resultats.Add unCode
            
            'on enlève ce qu'on vient de traiter
            Code = Replace(Code, Match.Value, "")
            
            'et on recommence
            Exit For
        End If
    Next
    
Loop While Len(Code) > 0 And boucleOut 'si boucleOut vaut false c'est qu'on vient de faire un tour complet et qu'on est sur un cas imprévu

If boucleOut = False Then
    ligne1 = "Erreur data imprévue" + vbCrLf
End If

For i = 1 To resultats.Count
    Set unCode = resultats(i)
    ligne1 = ligne1 + unCode.Texte
    ligne2 = ligne2 + vbCrLf + unCode.Description
Next
TestNeriXs4 = ligne1 + ligne2
End Function

Pour l'instant, exprès j'ai exclu 9X

Et le code de test

Sub Test()
Dim codes() As Variant
Dim Code As Variant
'mise de plusieurs codes de test dans un tableau
codes = Array("(01)00843997013703(11)210601(17)230601(21)3000105704", "010088483808258821DE7840AL79" + Chr(29) + "91867031", "0107332414124359210000107668" + Chr(29) + "11210208", "(01)00843997013703(11)210601(17)230601(10)54gp75P(21)3000105704", "(01)00843997013703(11)210601(10)54gp75P(17)230601(21)3000105704", "]C10100883873867792112207071723070710220707" + Chr(29) + "21PC22412085")

For Each Code In codes
    Debug.Print (Code)
    Debug.Print (TestNeriXs4(CStr(Code)))
    Debug.Print ("")
Next

End Sub

Dans lequel, d'une part GS n'apparait plus en texte mais \x21, et d'autre part, il y a un AI 91.

Je m'explique, je ne teste plus le code entier, mais juste le début pour un pattern, puis le suivant, puis le suivant etc..

Quand ça matche, je supprime la capture du code jusqu'à la fin.

Le risque, c'est de tomber sur un cas imprévu et de boucler à l'infini, j'ai donc mis un garde-fou et je le teste avec un AI 91.

Maintenant, on peut se pencher sur les 2 problèmes suivants

les AI à plus de 2 chiffres
	la méthode Description que tu ne vas pas coder avec 500 Case

Whismeril · Answer

Alors, ton groupe 13 et ton groupe 4, c'est la même chose, donc je les ai fusionnés.

Remodif de la classe, parce que j'ai pas envie de coder 500 cases

'Champs utiles
Public AI As String

Public Code As String

'Initialise l'instance de l'objet UnCode
Public Sub Init(LaBalise As String, LeCode As String)
    AI = LaBalise
    Code = LeCode
End Sub

'Méthode qui retourne un texte sous la forme "(Balise)LeCode"
Public Function Texte() As String
    Texte = "(" & AI & ")" & Code
End Function

'Méthode qui retourne un texte sous la forme "(Balise) Description : LeCode"
Public Function Description() As String
    Dim madescription As String
    
    Select Case AI
        Case "01"
            madescription = "(01) GTIN de l’article: "
    
        Case "11"
            madescription = "(11) Date de production: "
            
        Case "17"
            madescription = "(17) Date d'expiration : "
            
        Case "10"
            madescription = "(10) Numéro de lot: "
            
        Case "21"
            madescription = "(21) Numéro de série: "
        
        Case "91"
            madescription = "(91) InfosInternes: "
        
        Case Else
            madescription = "(" + AI + ") Déscription non codée : "
            
    End Select
           
    Description = madescription + Code
End Function

Modif du code principal, pour fusionner le pattern existant avec le groupe 13 et rajouter le 9x, maintenant qu'on a vu que le garde-fou fonctionne

'on met les patterns unitaires dans un tableau
patterns = Array("(?:](?:C1|e0|d2|Q3|J1))?$?(01)$?(" + caracteresOK + "{14})" + gs, _
            "$?(1[123567]|31[0-6][0-5]|3[35][0-7][0-5]|3[246]\d[0-5]|395\d|4326|7006|8005)$?(\d{6})" + gs, _
            "$?(10)$?(" + caracteresOK + "{1,20}?)" + fnc1, _
            "$?(21)$?(" + caracteresOK + "{1,20}?)" + fnc1, _
            "($?9[1-9]$?" + caracteresOK + "{0,90})" + fnc1 _
            )
'selon ton tableau, regroupés par "longueurs"
'3100 à 3105, 3110 à 3115, 3120 à 3125, 3130 à 3135, 3140 à 3145, 3150 à 3155, 3160 à 3165,
'3300 à 3305, 3310 à 3315, 3320 à 3325, 3330 à 3335, 3340 à 3345, 3350 à 3355, 3360 à 3365, 3370 à 3375,
'3500 à 3505, 3510 à 3515, 3520 à 3525, 3530 à 3535, 3540 à 3545, 3550 à 3555, 3560 à 3565, 3570 à 3575,
'3200 à 3205, 3210 à 3215, 3220 à 3225, 3230 à 3235, 3240 à 3245, 3250 à 3255, 3260 à 3265, 3270 à 3275, 3280 à 3285, 3290 à 3295,
'3400 à 3405, 3410 à 3415, 3420 à 3425, 3430 à 3435, 3440 à 3445, 3450 à 3455, 3460 à 3465, 3470 à 3475, 3480 à 3485, 3490 à 3495,
'3600 à 3605, 3610 à 3615, 3620 à 3625, 3630 à 3635, 3640 à 3645, 3650 à 3655, 3660 à 3665, 3670 à 3675, 3680 à 3685, 3690 à 3695,
'3950 à 3959,
'4326, 7006, 8005

À toi de jouer avec les autres.

Et concernant la méthode Description, je pense que le mieux est d'exporter tous les onglets de cette page https://www.gs1.org/standards/barcodes/application-identifiers dans un fichier excel.

Tu fais une recherche dans la colonne des AI et tu prends la description écrite sur la même ligne

NeriXs · Answer

Très prometteur, et quelle réflexion, je suis admiratif!

Avec ces codes :

codes = Array("(01)00843997013703(11)210601(17)230601(21)3000105704", "0109420012422286102101744203GS1121080421210804297823", "01076132030327041123090621800037578", "0107332414124359210000107668GS11210208")

J'obtiens:

(01)00843997013703(11)210601(17)230601(21)3000105704
(01)00843997013703(11)210601(17)230601(21)3000105704
(01) GTIN de l’article: 00843997013703
(11) Date de production: 210601
(17) Date d'expiration : 230601
(21) Numéro de série: 3000105704

0109420012422286102101744203GS1121080421210804297823
Erreur data imprévue
(01)09420012422286
(01) GTIN de l’article: 09420012422286

01076132030327041123090621800037578
(01)07613203032704(11)230906(21)800037578
(01) GTIN de l’article: 07613203032704
(11) Date de production: 230906
(21) Numéro de série: 800037578

0107332414124359210000107668GS11210208
(01)07332414124359(21)0000107668GS11210208
(01) GTIN de l’article: 07332414124359
(21) Numéro de série: 0000107668GS11210208

Whismeril · Answer

Avec celui là 0109420012422286102101744203GS1121080421210804297823

c'est normal, tu m'as dit qu'il n'y avait pas de GS en texte, donc je n'en tiens plus compte.

NeriXs · Answer

OUPS plus de GS, je n'avais pas compris

Sur ton poste #85, tu écris:
Dans lequel, d'une part GS n'apparait plus en texte mais \x21,

Ce n'est pas \x21, mais \x1d.

C'est OK

(01)00843997013703(11)210601(17)230601(21)3000105704
(01)00843997013703(11)210601(17)230601(21)3000105704
(01) GTIN de l’article: 00843997013703
(11) Date de production: 210601
(17) Date d'expiration : 230601
(21) Numéro de série: 3000105704

0109420012422286102101744203GS1121080421210804297823
(01)09420012422286(10)2101744203(11)210804(21)210804297823
(01) GTIN de l’article: 09420012422286
(10) Numéro de lot: 2101744203
(11) Date de production: 210804
(21) Numéro de série: 210804297823

01076132030327041123090621800037578
(01)07613203032704(11)230906(21)800037578
(01) GTIN de l’article: 07613203032704
(11) Date de production: 230906
(21) Numéro de série: 800037578

0107332414124359210000107668GS11210208
(01)07332414124359(21)0000107668(11)210208
(01) GTIN de l’article: 07332414124359
(21) Numéro de série: 0000107668
(11) Date de production: 210208

Whismeril · Answer

Ce n'est pas \x21, mais \x1d.

Ha oui faute de frappe, c'est \x1d qui sert de borne dans les regex.

En plus G et S sont des caractères autorisés donc la possibilité qu'ils se retrouvent à la suite dans une description existe.

Pour les descriptions à longueur fixe, même si fnc1 est requis, tu peux le laisser optionnel, (c'est peut-être le cas de certains dans ton groupe 13, j'ai pas vérifié les 300 lignes) la regex s'arrêtera à la taille fixe et consommera le \xd1 ou la parenthèse s'ils sont présents.

Pour cette façon de faire, il est nécessaire que l'AI soit dans un groupe de capture et la description dans le second. Sachant que l'AI peut être entouré de parenthèses et que celles-ci ne doivent pas être dans le groupe.

NeriXs · Answer

Bonsoir Whismeril,

J'ai regardé pour corriger mon tableau des groupes de patterns, j'ai des doublons de groups au niveau du pattern.

Exemple: (\d{18})$ pour le groupe 1) balise 00 et le groupe 51) balises 8017 et 8018, mais le groupe 1) ne requière pas de balise de fin contrairement au groupe 51.

Dans ce cas nous ne devons pas le fusionner.

Je vais en priorité m'occuper de ça!

J'ai passé pas mal de temps à analyser ton code et étudier tes patterns regroupés.

Tu as appliqué "caracteresOK" a la balise 01, elle en a normalement pas besoin selon le tableau?

J'ai commencé a rédigé les patterns en commençant par le début du tableau.

Je me suis arrêté au groupe 6 vu que je dois reprendre les doublons du tableau avant!

Peux-tu me confirmer que je suis sur la bonne voie?

' Où X = Balises multiples

'Groupe [1]
'Balise: 00
'Pattern GS1: ^0(\d{18})$
"$?(00)$?(\d{18})" + gs, _

'Groupe [2]
'Balise: 01, 02
'Pattern GS1: ^X(\d{14})$
"$?(0[12])$?(\d{14})" + gs, _

'Groupe [3]
'Balise: 10, 21, 22
'Pattern GS1:  ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,20})$
'caracteresOK = "[\x21-\x22\x25-\x3F\x41-\x5A\x5F\x61-\x7A]"
'Pattern Modifier = ^X([\x21-\x22\x25-\x3F\x41-\x5A\x5F\x61-\x7A]{0,20})$
"($?(2[12]|10)$?" + caracteresOK + "{0,20})" + fnc1, _

'Le groupe 4 a été fusionné avec le groupe 13, je passe au groupe 5.

'Groupe [5]
'Balise: 20
'Pattern GS1: ^20(\d{2})$
"$?(20)$?(\d{2})" + gs, _

'Groupe [6]
'Balise: 235
'Pattern GS1: ^235([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,28})$
'caracteresOK = "[\x21-\x22\x25-\x3F\x41-\x5A\x5F\x61-\x7A]"
'Pattern Modifier = ^235([\x21-\x22\x25-\x3F\x41-\x5A\x5F\x61-\x7A]{0,28})$
"($?(235)$?" + caracteresOK + "{0,28}?)" + fnc1, _

Je ne serais pas disponible demain et mercredi, mais je reviens jeudi ;)

NeriXs · Answer

Bonjour Whismeril,

Je n'ai pas le droit au bouton de citation:

J'ai travaillé sur la dénomination des balises (AI)

00 : N° CONTENEUR (SSCC)
01 : N° ARTICLE (GTIN)
02 : N° ARTICLES CONTENUS
10 : N° LOT
11 : DATE PRODUCTION
12 : DATE ECHEANCE
13 : DATE EMBALLAGE
15 : DATE PREREMPTION
16 : DATE VENTE
17 : DATE EXPIRATION
20 : VARIANTE ARTICLE
21 : N° SÉRIE
22 : VARIANTE PRODUIT
235 : EXTANSION CONTROLE
240 : ID ADDITIONNEL
241 : N° PIECE
242 : N° VARATION
243 : N° EMBALAGE
250 : N° SÉRIE SECONDAIRE
251 : REF SOURCE
253 : IDENTIFICATEUR DOC (GDTI)
254 : COMPOSANT EXTENSION (GLN)
255 : N° COUPON (GCN)
30 : NB VARIABLE ARTICLES
3100-3105 : POIDS NET (kg)
3110-3115 : LONGUEUR (m)
3120-3125 : LARGEUR (m)
3130-3135 : HAUTEUR (m)
3140-3145 : SUPERFICIE (m²)
3150-3155 : VOLUME NET (l)
3160-3165 : VOLUME NET (m³)
3200-3205 : POIDS NET (lb)
3210-3215 : LONGUEUR (in)
3220-3225 : LONGUEUR (ft)
3230-3235 : LONGUEUR (yd)
3240-3245 : LARGEUR (in)
3250-3255 : LARGEUR (ft)
3260-3265 : LARGEUR (yd)
3270-3275 : HAUTEUR (in)
3280-3285 : HAUTEUR (ft)
3290-3295 : HAUTEUR (yd)
3300-3305 : POIDS BRUT (kg)
3310-3315 : LONGUEUR (m), logistique
3320-3325 : LARGEUR (m), grume
3330-3335 : HAUTEUR (m), grume
3340-3345 : SUPERFICIE (m²), logistique
3350-3355 : VOLUME (l), logistique
3360-3365 : VOLUME (m³), logistique
3370-3375 : KG PAR m²
3400-3405 : POIDS BRUT (lb)
3410-3415 : LONGUEUR (po), bille
3420-3425 : LONGUEUR (ft), bille
3430-3435 : LONGUEUR (yd), bille
3440-3445 : LARGEUR (po), grume
3450-3455 : LARGEUR (ft), grume
3460-3465 : LARGEUR (yd), grume
3470-3475 : HAUTEUR (po), grume
3480-3485 : HAUTEUR (ft), grume
3490-3495 : HAUTEUR (yd), grume
3500-3505 : SUPERFICIE (in²)
3510-3515 : SURFACE (pi²)
3520-3525 : SUPERFICIE (yd²)
3530-3535 : SUPERFICIE (in²), logistique
3540-3545 : SUPERFICIE (pi²), logistique
3550-3555 : SUPERFICIE (yd²), logistique
3560-3565 : POIDS NET (t oz)
3570-3575 : VOLUME NET (oz)
3600-3605 : VOLUME NET (qt)
3610-3615 : VOLUME NET (gal.)
3620-3625 : VOLUME (qt), logistique
3630-3635 : VOLUME (gal.), logistique
3640-3645 : VOLUME (po³)
3650-3655 : VOLUME (pi³)
3660-3665 : VOLUME (yd³)
3670-3675 : VOLUME (po³), bille
3680-3685 : VOLUME (pi³), rondin
3690-3695 : VOLUME (yd³), logistique
37 : COMPTAGE UNITÉ, logistique
3900-3909 : MONTANT
3910-3919 : MONTANT (ISO)
3920-3929 : PRIX
3930-3939 : PRIX (ISO)
3940-3943 : REMISE %
3950-3955 : PRIX / UoM
400 : NUMÉRO DE COMMANDE
401 : N° INDENTIFICATION (GINC)
402 : N° INDENTIFICATION (GSIN)
403 : CODE ROUTAGE
410 : EXPÉDIER À
411 : FACTURER À
412 : ACHAT AUPRÈS DE
413 : EXPÉDIER POUR
414 : N° LOC
415 : PAYER À
416 : PROD/SERV LOC
417 : PARTIE
420 : EXPÉDIER CODE POSTAL
421 : EXPÉDIER CODE POSTAL (ISO)
422 : ORIGINE
423 : PAYS - PROCESSUS INITIAL
424 : PAYS - PROCESSUS
425 : PAYS - DÉSASSEMBLAGE
426 : PAYS - PROCESSUS COMPLET
427 : SUBDIVISION ORIGINE
4300 : ENVOYER À SOCIÉTÉ
4301 : ENVOYER AU NOM
4302 : ENVOYER À ADD1
4303 : ENVOYER À ADD2
4304 : ENVOYER À BANLIEUE
4305 : ENVOYER À LOC
4306 : ENVOYER VERS REG
4307 : ENVOYER AU PAYS
4308 : ENVOYER AU TÉLÉPHONE
4309 : ENVOI VERS GEO
4310 : RETOUR À SOCIÉTÉ
4311 : RETOUR AU NOM
4312 : RETOUR À ADD1
4313 : RETOUR À ADD2
4314 : RETOUR EN BANLIEUE
4315 : RETOUR À LOC
4316 : RETOUR À REG
4317 : RETOUR AU PAYS
4318 : RETOUR CODE POSTAL
4319 : RETOUR AU TÉLÉPHONE
4320 : DESCRIPTION DU SERVICE
4321 : MARCHANDISES DANGEREUSES
4322 : AUTORISATION DE SORTIE
4323 : SIGNATURE REQUIS
4324 : PAS AVANT DATE
4325 : PAS APRES DATE
4326 : DATE DE SORTIE
7001 : N° STOCK OTAN (NSN)
7002 : DÉCOUPE DE VIANDE
7003 : DATE DE PÉREMPTION
7004 : PUISSANCE ACTIVE
7005 : ZONE DE CAPTURE
7006 : DATE DE LA PREMIERE CONGELATION
7007 : DATE DE RÉCOLTE
7008 : ESPÈCES AQUATIQUES
7009 : TYPE D'ENGIN DE PÊCHE
7010 : MÉTHODE DE PRODUCTION
7011 : DATE LIMITE D'ESSAI
7020 : RÉNOVATION LOT
7021 : STATUS FONCTIONNEL
7022 : STATUS RÉVISION
7023 : ID ASSEMBLAGE(GIAI)
7030 : PROCESSEUR ISO # 0
7031 : PROCESSEUR ISO # 1
7032 : PROCESSEUR ISO # 2
7033 : PROCESSEUR ISO # 3
7034 : PROCESSEUR ISO # 4
7035 : PROCESSEUR ISO # 5
7036 : PROCESSEUR ISO # 6
7037 : PROCESSEUR ISO # 7
7038 : PROCESSEUR ISO # 8
7039 : PROCESSEUR ISO # 9
7040 : UIC+EXT
710 : NHRN PZN
711 : NHRN CIP
712 : NHRN CN
713 : NHRN DRN
714 : NHRN AIM
715 : NHRN NDC
7230 : CERT # 1
7231 : CERT # 2
7232 : CERT # 3
7233 : CERT # 4
7234 : CERT # 5
7235 : CERT # 6
7236 : CERT # 7
7237 : CERT # 8
7238 : CERT # 9
7239 : CERT # 10
7240 : PROTOCOLE
7241 : TYPE DE SUPPORT AIDC
7242 : VCN
8001 : DIMENSIONS
8002 : CMT No.
8003 : GRAI
8004 : GIAI
8005 : PRIX PAR UNITÉ
8006 : ITIP
8007 : IBAN
8008 : HEURE PRODUCTION
8009 : OPTSEN
8010 : CPID
8011 : CPID SERIE
8012 : VERSION
8013 : GMN
8017 : GSRN - PRESTATAIRE
8018 : GSRN - DESTINATAIRE
8019 : SRIN
8020 : REF No.
8026 : CONTENU ITIP
8030 : DIGSIG
8110 : code coupon
8111 : POINTS
8112 : ID COUPON
8200 : URL DU PRODUIT
90 : INTERNE MUTUELLE
91-99 : INTERNE

Là je m'arrache les cheveux avec les patterns, plus exactement les parenthèses.

Je pense que mes patterns sont bon, mais rien ne fonctionne à cause de ces foutu parenthèses.

Pourrais-tu regarder ou je fais erreur?

' Où X = Balises multiples

'Groupe [1]
'Balise: 00
'Pattern GS1: ^0(\d{18})$
"$?(00)$?(\d{18})" + gs, _

'Groupe [2]
'Balise: 01, 02
'Pattern GS1: ^X(\d{14})$
"$?(0[12])$?(\d{14})" + gs, _

'Groupe [3]
'Balise: 10, 21, 22, 243, 254, 420, 710, 711, 712, 713, 714, 715, 4318, 7020, 7021, 7022, 7240, 8002, 8012  
'Pattern GS1:  ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,20})$
'caracteresOK = "["!%-?A-Z_a-Z]"
'Pattern GS1 Modifier = ^X(["!%-?A-Z_a-Z]{0,20})$
"($?(2[12]|10|243|254|520|71[0-5]|4318|702[0-2]|7240|8002|8012)$?" + caracteresOK + "{0,20})" + fnc1, _

'Groupe [4]
'Balise: 20
'Pattern GS1: ^20(\d{2})$
"$?(20)$?(\d{2})" + gs, _

'Groupe [5]
'Balise: 235
'Pattern GS1: ^235([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,28})$
'caracteresOK = "["!%-?A-Z_a-Z]"
'Pattern GS1 Modifier = ^235(["!%-?A-Z_a-Z]{0,28})$
"($?(235)$?" + caracteresOK + "{0,28}?)" + fnc1, _

'Groupe [6]
'Balise: 90, 240, 241, 250, 251, 400, 401, 403, 4308, 4319, 7002, 7023, 8004  
'Pattern GS1:  ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,30})$
'caracteresOK = "["!%-?A-Z_a-Z]"
'Pattern GS1 Modifier = ^X(["!%-?A-Z_a-Z]{0,30})$
"($?(90|24[0-1]|25[0-1]|40[0-13|4308|7319|7002|7023|8004)$?" + caracteresOK + "{0,30})" + fnc1, _

'Groupe [7]
'Balise: 242
'Pattern GS1:  ^242(\d{0,6})$
"($?(242)$?(\d{0,6})" + gs, _

'Groupe [8]
'Balise: 253
'Pattern GS1: ^253(\d{13})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,17})$
'caracteresOK = "["!%-?A-Z_a-Z]"
'Pattern GS1 Modifier = ^253(\d{13})(["!%-?A-Z_a-Z]{0,17})$
"($?(253)$?(\d{13})(" + caracteresOK + "{0,17}?)" + fnc1, _

'Groupe [9]
'Balise: 255
'Pattern GS1:  ^255(\d{13})(\d{0,12})$
"($?(255)$?(\d{13})(\d{0,12}?)" + fnc1, _

'Groupe [10]
'Balise: 30, 37
'Pattern GS1: ^X(\d{0,8})$
"($?(30|37)$?(\d{0,8}?)" + fnc1, _

'Groupe [11]
'Balise: 
'11, 12, 13, 15, 16, 17 
'3100 à 3105, 3110 à 3115, 3120 à 3125, 3130 à 3135, 3140 à 3145, 3150 à 3155, 3160 à 3165,
'3300 à 3305, 3310 à 3315, 3320 à 3325, 3330 à 3335, 3340 à 3345, 3350 à 3355, 3360 à 3365, 3370 à 3375,
'3500 à 3505, 3510 à 3515, 3520 à 3525, 3530 à 3535, 3540 à 3545, 3550 à 3555, 3560 à 3565, 3570 à 3575,
'3200 à 3205, 3210 à 3215, 3220 à 3225, 3230 à 3235, 3240 à 3245, 3250 à 3255, 3260 à 3265, 3270 à 3275, 3280 à 3285, 3290 à 3295,
'3400 à 3405, 3410 à 3415, 3420 à 3425, 3430 à 3435, 3440 à 3445, 3450 à 3455, 3460 à 3465, 3470 à 3475, 3480 à 3485, 3490 à 3495,
'3600 à 3605, 3610 à 3615, 3620 à 3625, 3630 à 3635, 3640 à 3645, 3650 à 3655, 3660 à 3665, 3670 à 3675, 3680 à 3685, 3690 à 3695,
'3950 à 3959,
'4326, 7006, 8005
'Pattern GS1: ^X(\d{6})$
"$?(1[123567]|31[0-6][0-5]|3[35][0-7][0-5]|3[246]\d[0-5]|395\d|4326|7006|8005)$?(\d{6})" + gs, _

'Groupe [12]
'Balise: 7007
'Pattern GS1: ^7007(\d{6,12})$
"($?(7007)$?(\d{6,12})?)" + fnc1, _

'Groupe [13]
'Balise: 7011
'Pattern GS1:  ^7011(\d{6})(\d{0,4})$
"($?(7011)$?(\d{6})(\d{0,8}?)" + fnc1, _

'Groupe [14]
'Balise: 3900 à 3909, 3920 à 3929 
'Pattern GS1:   ^X(\d{0,15})$
"($?(390[0-9]|392[0-9])$?(\d{0,15})?)" + fnc1, _

'Groupe [15]
'Balise: 3910 à 3919, 3930 à 3939  
'Pattern GS1:    ^X(\d{3})(\d{0,15})$
"($?(391[0-9]|393[0-9])$?(\d{3})(\d{0,15})?)" + fnc1, _

'Groupe [16]
'Balise: 3940 à 3943, 8111 
'Pattern GS1:  ^X(\d{4})$
"($?(394[0-3]|8111)$?(\d{4})?)" + fnc1, _

Whismeril · Answer

Bonsoir,

en effet, il faut être très vigilant avec les parenthèses (la preuve....)

En regex, elles délimitent un groupe, ce groupe peut être

un groupe de capture "SubMatch en VBA"
	
ab(.+)ba
	, va créer une capture de tout ce qu'il y a entre ab et ba.
	un groupe "non capturant", par exemple pour borner un ou,
	
ab(?:12|21)ba
	matchera ab12ba ou ab21ba et "SubMatchera" 12 ou 21

J'ai basé le traitement actuel sur le fait qu'une SubMatch sera l'AI et l'autre la description.

Mais les AI peuvent être elles-mêmes entourés de parenthèses.

Il faut donc encadrer le groupe de capture de l'AI de parenthèses échapées et optionnelle.

Ce qui pour l'AI 1234 donne

$?(1234)$?

Teste tes patterns sur regex101, tu vois le résultat en direct, tu as le détail des groupes de captures

Je te conseille de commencer par valider les fusions d'AI, puis de les entourer d'un groupe de capture et des parenthèses optionnelles.

Whismeril · Answer

Petite correction de mon message précédent, le second pattern ne submathera pas 12 ou 21'

'Groupe [2]
'Balise: 01, 02
'Pattern GS1: ^X(\d{14})$
"$?(0[12])$?(\d{14})"

Là on a un parfait exemple, de pattern que tu pourrais travailler avec regex101.

À cette étape, on a oublié le fnc du début, qui ne s'applique que pour l'AI 01.

https://regex101.com/r/LtbF4O/1

Peut-on trouver un pattern fusionné, de tel sorte que l'AI soit dans le groupe de capture 1 et la data dans le 2.

Au moment où je tape ces lignes, je n'en sais rien (et j'ai pas vba sous la main, juste regex 101).

D'abord, je vire les parenthèses optionnelles du pattern.

Ensuite, je teste avec un ou

https://regex101.com/r/LtbF4O/2

Je capture bien les 2 premières lignes et j'ai bien mes données dans les bons groupes de capture.

Ensuite j'ajoute un ]C1 optionnel qui le fait pas un groupe de capture (on traitera tous les cas si on s'en sort avec celui-ci)

https://regex101.com/r/LtbF4O/3
Là, mauvaise donne, je n'ai pas 3 troisième groupe de capture (qui en plus s'insèrerait au début et donc passerait l'AI au 2eme et la data au 3eme). Mais ]C1 est inclus dans le groupe de capture 1 (et c'est logique il est à l'intérieur de la parenthèse capturante).

Là plusieurs options

on sépare les patterns comme tu l'as fait
	on ne s'embête pas plus avec les regex, on virera le ]C1 dans le traitement ultérieur 
	on essaye de sortir]C1 de la parenthèse capturante, à première vue, on risque de mathcer ]C102 aussi, est-ce grave? Si ce cas ne se présente jamais non, si ce cas peut arriver, à toi de voir https://regex101.com/r/LtbF4O/4
	on continue d'essayer de trouver un pattern qui ne capture pas ]C1 avec 02, ne le mets pas dans le groupe 1, ne décale pas les groupes existants (c'est pas gagné)
	on passe un pattern de remplacement avant de décomposer le code, si le code débute par ]C101, on vire ]C1 https://regex101.com/r/RkwX0b/1 et du coup en peut appliquer le pattern qui capture les AI 01 et 02
	on peut faire en sorte que ]C1 crée le groupe de capture 1, donc l'AI dans le 2 et la data dans le 3 et modifier le traitement vba pour qu'il ne prenne plus les submatches 1 et 2 mais avant dernier et dernier

Quelque soit ton choix, c'est seulement après que tu rajoutes les parenthèses optionnelles en dehors du groupe de capture de l'AI

NeriXs · Answer

Les possibilités ne manquent pas!

Mais au final, est-ce vraiment un problème de gérer les AI 01 et 02 séparément ?

"(?:](?:C1|e0|d2|Q3|J1))?$?(01)$?(\d{14})" + gs, _
"$?(02)$?(\d{14})" + gs, _

Même si au final, il y aura une cinquantaine de patterns à gérer, la solution que tu as développée semble robuste ?

On évite les cas imprévus.

Au passage pour le traitement des descriptions, quand celle-ci est la même pour plusieurs AI.

Vois-tu un inconvénient à l'utilisation d'un Select Case avec Case multiple ?

Dans l'idée, pour les AI 3100 à 3105 : POIDS NET (kg)

Select Case AI
        Case "3100", "3101", "3102", "3102", "3104", "3105"
            madescription = "(" + AI + ")  POIDS NET (kg): "

NeriXs · Answer

Pas de problème, tes explications sont bonnes à prendre et me facilite la recherche, encore merci pour le temps accordé.

Juste pour lever un petit doute.

Concernant ce pattern:
^255(\d{13})(\d{0,12})$
\d = pour [0-9]
{13} = 13 caractères
\d = pour [0-9]
{0,12} = de 0 à 12 caractères
Donc la valeur de 255 est de 13 chiffres + suite de 0 à 12 caractères
Donc 255 peut couvrir une suite de 13 à 25 caractères
C'est bien ça?

Au fait, dans un précèdent poste du avais donné des patterns de substitution au patterns GS1.

Soit:
GS1 que tu as déjà optimisé : [\x21-\x22\x25-\x3F\x41-\x5A\x5F\x61-\x7A]
Substitution : ["!%-?A-Z_a-Z]
VBA ne semble pas aimer le guillemet entre crochets!

Idem pour: [\x21\x22\x25-\x39\x5F\x61-\x7A]
Substitution : [!"%-9_a-z]

Je n'ai pas eu l'occasion de tester avec celui-ci:
GS1 que tu as aussi optimisé : [\x21\x22\x25-\x39\x5F\x61-\x7A]
Substitution : [#\x2D/0-9A-Z]

Whismeril · Answer

Donc 255 peut couvrir une suite de 13 à 25 caractères
C'est bien ça?

Oui, mais du coup \d{13, 25} devrait faire l'affaire.

VBA ne semble pas aimer le guillemet entre crochets!

Non, mais le guillemet signe la fin de la string, il faut l'échapper et je ne sais plus comment on fait en vba double guillemets peut-être.

Mais sinon, avec les valeurs hexa ça va le faire

NeriXs · Answer

Je galère avec ce pattern:

Pattern du Site SG1=
^253(\d{13})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,17})$

Pattern que j'essaie de construire
"$?(253)$?(\d{13})?(" + caracteresOK + "{0,17}?)" + fnc1, _

Où:
fnc1 = "(\x1d|$|\()"
caracteresOK = "[\x21\x22\x25-\x3F\x41-\x5A\x5F\x61-\x7A]"

Code de test avec 13 caractères après 253:
codes = Array("01073324141243592531234567891234" + Chr(29) + "210000107668" + Chr(29) + "11210208")

J'obtiens

Test 1:
253 vaut 13 caractères:

0107332414124359253123456789123421000010766811210208
(01)07332414124359(253)1234567891234(21)0000107668(11)210208
(01) N° ARTICLE (GTIN): 07332414124359
(253) Déscription non codée : 1234567891234
(21) N° SÉRIE: 0000107668
(11) test: 210208
Test 1 OK

Test 2:
253 vaut 12 caractères:

010733241412435925312345678912321000010766811210208
(01)07332414124359(253)(21)0000107668(11)210208
(01) N° ARTICLE (GTIN): 07332414124359
(253) Déscription non codée :
(21) N° SÉRIE: 0000107668
(11) test: 210208
Test 2 ECHEC, J'ai un vide entre 253 et 21:
(01)07332414124359(253)(21)0000107668(11)210208
Vide aussi dans le détail
(253) Déscription non codée :

Test 3:
253 vaut 14 caractères:
01073324141243592531234567891234521000010766811210208
(01)07332414124359(253)1234567891234(21)0000107668(11)210208
(01) N° ARTICLE (GTIN): 07332414124359
(253) Déscription non codée : 1234567891234
(21) N° SÉRIE: 0000107668
(11) test: 210208
Test 4 ECHEC, seulement 13 caractère prit en compte

NeriXs · Answer

Ces patterns sont dans le même cas ?

^255(\d{13})(\d{0,12})$

^7011(\d{6})(\d{0,4})$

^3910(\d{3})(\d{0,15})$

^423(\d{3})(\d{0,12})$

^8008(\d{8})(\d{0,4})$

Encore pire 3 groupes

^8006(\d{14})(\d{2})(\d{2})$

NeriXs · Answer

Bonjour, Je suis tombé sur les éléments qui compose un AI! Ce n'est pas inclue à ma dodo liste, mais qui sait pour plus tard. Pour l'AI 253 Ce qu'on utilise déjà: 253 => N3+N13[+X..17] => ^253(\d{13})([\x21\x22\x25-\x3F\x41-\x5A\x5F\x61-\x7A]{0,17})$ Les éléments 253=N13,csum,key [X..17] Soit: N13 = 13 caractères numérique Csum = { int weight; int parity = 0; const char *p; size_t len, pos; assert(data); len = strlen(data); /* * Data must include at least the check digit. * */ if (*data == '\0') { if (err_pos) *err_pos = 0; if (err_len) *err_len = 0; return GS1_LINTER_TOO_SHORT_FOR_CHECK_DIGIT; } /* * Data must consist of all digits. * */ if ((pos = strspn(data, "0123456789")) != len) { if (err_pos) *err_pos = pos; if (err_len) *err_len = 1; return GS1_LINTER_NON_DIGIT_CHARACTER; } /* * Calculate the sum of the numeric values of the data, excluding the * check digit, weighted by alternating ...3:1:3 values, from right to * left. * * The check digit is valid if its value, when added to the data * checksum, makes the overall sum a multiple of 10. * */ weight = len % 2 == 0 ? 3 : 1; p = data; while (*(p+1)) { parity += weight * (*p++ - '0'); weight = 4 - weight; } parity = (10 - parity % 10) % 10; if (parity + '0' != *p) { if (err_pos) *err_pos = len - 1; if (err_len) *err_len = 1; return GS1_LINTER_INCORRECT_CHECK_DIGIT; } return GS1_LINTER_OK; } Key = { size_t i, len; assert(data); len = strlen(data); /* * The current minimum GCP length is defined by GCP_MIN_LENGTH. * */ if (len < GCP_MIN_LENGTH) { if (err_pos) *err_pos = 0; if (err_len) *err_len = len; return GS1_LINTER_TOO_SHORT_FOR_KEY; } /* * Any character within the minimum-length GCP prefix that is outside * the range '0' to '9' is illegal. * */ for (i = 0; i < GCP_MIN_LENGTH; i++) { if (data[i] < '0' || data[i] > '9') { if (err_pos) *err_pos = i; if (err_len) *err_len = 1; return GS1_LINTER_INVALID_GCP_PREFIX; } } /* * Call the custom GCP lookup routine if one has been provided. * */ #ifdef GS1_LINTER_CUSTOM_GCP_LOOKUP { int valid = 0, offline = 0; GS1_LINTER_CUSTOM_GCP_LOOKUP(data); if (offline) return GS1_LINTER_GCP_DATASOURCE_OFFLINE; else if (!valid) return GS1_LINTER_INVALID_GCP_PREFIX; } #endif return GS1_LINTER_OK; } X = CSET 82 { /* * All characters in "CSET 82", the 82 character alphabet. * */ static const char *cset82 = "!\"%&'()*+,-./0123456789:;<=>?ABCDEFGHIJKLMNOPQRS" "TUVWXYZ_abcdefghijklmnopqrstuvwxyz"; size_t pos; assert(data); /* * Any character outside of CSET 82 is illegal. * */ if ((pos = strspn(data, cset82)) != strlen(data)) { if (err_pos) *err_pos = pos; if (err_len) *err_len = 1; return GS1_LINTER_INVALID_CSET82_CHARACTER; } return GS1_LINTER_OK; } De ce que je comprends: L'AI 253 est composé de 12 caractères numérique + une clé de contrôle + 0 à 17 caractères quelconques. Cette clé de contrôle est calculée de cette façon: On attribue le rang de 1 à 13 et de droite à gauche. 13 12 11 10 9 8 7 6 5 4 3 2 1 Où 1 est la clé de contrôle calculé, on en tien donc pas compte. Exemple: 34531023645? On additionne les chiffres du code de rang paire 4 + 3 + 2 + 2 + 6 + 5 = 22 On multiplie le résultat par 3 22 * 3 = 66 On additionne les chiffres du code de rang impair 3 + 5 + 1 + 0 + 3 + 4 = 16 On additionne les deux résultats: 66 + 16 = 82 On soustrait le résultat du multiple de 10 supérieur 90 – 82 = 8 La clé de contrôle est 8 L'AI 253 est donc: 34531023645 + 8 + 0 à 17 caractères quelconques. Lorsque le résultat des additions est un multiple de 10 la clé de contrôle est égal à 0. Penses-tu que cela soit applicable facilement en VBA sous la case 253 du module de class unCode?

Whismeril · Answer

Bonjour

oui, par contre, dans le code C que tu as posté, ils ont fair une fonction pour ça.

Ça laisse entendre que d'autres data pourraient être validées pas un checksum de ce type.

Je pense donc qu'il faut faire de même, et appeler cette fonction chaque fois que c'est nécessaire.

NeriXs · Answer

Oui, Il y a le détaille ici:

https://github.com/gs1/gs1-syntax-dictionary/blob/main/gs1-syntax-dictionary.txt

Gros travail, plusieurs fonctions, mais je suis incapable de les porter sous VBA !

https://gs1.github.io/gs1-syntax-dictionary/index.html

Et tout un projet:

https://github.com/gs1/gs1-syntax-engine

Projet que je viens de tester en version compilé, mais qui impose un FNC1 de début pour chaque code lut.

https://github.com/gs1/gs1-syntax-engine/releases/tag/2023-07-05

App Windows:

https://github.com/gs1/gs1-syntax-engine/releases/download/2023-07-05/gs1encoders-windows-gui-app.zip

Cet App utilise une Dll, mais je doute que ce soit exploitable sous VBA:

https://github.com/gs1/gs1-syntax-engine/releases/download/2023-07-05/gs1encoders-windows-libs.zip

Whismeril · Answer

S'il ne s'agit que du checksum, tu as décrit l'algo, il n'est pas très compliqué, y'a plus qu'à

Pas besoin de savoir lire le C.

NeriXs · Answer

Dans l'algorithme que je décris et seulement pour trouver la clé d'une chaine de 12 caractères:

Function FindKey13(ForString12)
For i = 1 To Len(ForString12)
    s = s + Mid(ForString12, i, 1) * (1 + (1 - i Mod 2) * 2)
Next i
    If s Mod 10 = 0 Then
        FindKey13 = 0
    Else
        FindKey13 = 10 - s Mod 10
    End If
End Function

En testant le générateur de clés GS1
https://www.gs1.fr/calculer-cle-controle

Je vois qu'il peut générer les clés suivantes:

GTIN-8, soit 7 caractères + 1 caractère la clé.
GTIN-12, soit 11 caractères + 1 caractère la clé.
GTIN-13, soit 12 caractères + 1 caractère la clé.
GTIN-14, soit 13 caractères + 1 caractère la clé.
GSIN-17, soit 16 caractères + 1 caractère la clé.
SSCC-18, soit 17 caractères + 1 caractère la clé.

Ces codes sont présents dans mes AIs, mais là je ne sais pas comment gérer.

L'utilisation de Mod, m'évite de me perdre dans les nombres paires ou impaires, mais complique la tâche.

NeriXs · Answer

Impeccable, testé et validé pour GTIN-8, GTIN-12, GTIN-13, GTIN-14, GSIN-17 et SSCC-18.

Je mets de côté, car là je m'écarte du sujet de départ.

Je me remets dès ce soir sur mes Patterns.

Merci.

NeriXs · Answer

Bonsoir,

En voulant garder un code lisible, j'ai continué de mettre sur une ligne différente chaque pattern.

Patterns = Array("Pattern1", _
                 "Pattern2", _
                 "Pattern3" _
                 "Pattern3", _
                 "Pattern4" _
                 "Pattern5" _
                 "Pattern6" _
                 )

Je me retrouve avec le message "Trop de caractères de continuité de ligne"

Je peux réduire:

Patterns = Array("Pattern1", "Pattern2", "Pattern3" _
                 "Pattern4", "Pattern5", "Pattern6" _
                 )

Mais, c'est bien moins lisible.

J'ai tenté :

patterns = strPatterns
           strPatterns = "Pattern1"
           strPatterns = strPatterns & "Pattern2"
           strPatterns = strPatterns & "Pattern3"
           strPatterns = strPatterns & "Pattern4"
           strPatterns = strPatterns & "Pattern5"
           strPatterns = strPatterns & "Pattern6"

Je n'avais pas pensé a "For Each pattern In patterns" qui utilise le "Array"

Voix tu une possibilité autre que de moins Utiliser de caractères de continuité de ligne "_" ?

Whismeril · Answer

Bonjour

tu peux utiliser une Collection

NeriXs · Answer

Bonjour,

Une Collection, Pourquoi je ni penses pas!

Je ne sais pas si on peut optimiser :

Sub ListPatterns()

Dim patterns As New Collection

patterns.Add "MonPattern 1"
patterns.Add "MonPattern 2"
patterns.Add "MonPattern 3"

For Each pattern In patterns
    If pattern = "MonPattern 2" Then
        MsgBox pattern & ", est présent dans la liste!"
    End If
Next pattern

End Sub

NeriXs · Answer

Je reviens sur les patterns avec 2 groupes de data

"$?(703[0-9])$?(\d{3}" + caracteresOK + "{0,27}?)" + fnc1

Que je test sous regex101 avec des nombres a la place des caractères OK

^$?(703[0-9])$?(\d{3}\d{0,27})$

Ici cela nous donne un groupe de 3 + 27 caractère soit 30 caractères.

Soit: ^\(?(703[0-9])$?(\d{3,30})$ qui revint à ^\(?(703[0-9])$?(\d{30})\(

Comme tu l'évoquais, ces groupes de data, ici 3 caractères pour le 1er et 0 à 27 caractères pour le second ont une raison.

J'envisage si c'est possible d'exploiter ces groupes de data.

J'ai repris nos échanges, mais n'ai pas retrouvé ce que cela impacterait de tenter de les prendre en charge ?

Il y a aussi le cas des AI 8006 et 8026 qui elles ont 3 groupes de data:

Format : N4+N14+N2+N2
Pattern GS1: ^8006(\d{14})(\d{2})(\d{2})$

Whismeril · Answer

https://codes-sources.commentcamarche.net/forum/affich-10112115-regex-recherche-patten-de-capture-un-defi?page=5#p10112335

NeriXs · Answer

Citation:
•    soit on modifie la méthode init pour quelle stocke différemment les données si on lui donne plus que 2 paramètres. Mais, encore faut il savoir comment stocker dans quels cas
•    soit dans le select case, pour les cas en question, tu redécoupes la donnée soit avec Left et right, quand tu as au moins une longueur fixe, soit en regex

Je serai tenté de pencher pour la 1ère solution à un stockage de données par groupe et dans l'ordre, mais j'ai beaucoup de difficultés à me projeter là-dessus et encore moins sur le comment faire.
Il faut pouvoir exploiter cela après.

Si je reprends:
AI 8006
N14+N2+N2
8006 = 1er groupe, groupe de capture
N14 = 2 eme groupe, groupe data 1
N2 = 3 eme groupe, groupe data 2
N2 = 4 eme groupe, groupe data 3

La deuxième solution, depuis le Select Case, vu qu'on fusionne les groupes:

De:

"$?(253)$?(\d{13})?(" + caracteresOK + "{0,17}?)" + fnc1

Pour:

"$?(253)$?(\d{13}" + caracteresOK + "{0,17})" + fnc1

Je ne sais pas trop comment les exploiter.

Il y a encore du triturage de cerveau dans l'air !

Personnellement comment gérerais-tu ?

Whismeril · Answer

Comment voudrais-tu que ce soit affiché ?

NeriXs · Answer

Je ne sais pas trop, mais le but et d'exploiter les données.

Toujours concernant AI 8006

Format: N4+N14+N2+N2

Pattern GS1: ^8006(\d{14})(\d{2})(\d{2})$

La vérification de la clé de contrôle sur N14 "CheckSum"
Sur le 1er N2 = N° de la pièce (2 chiffres)
Sur le 2éme N2 = Nombre total de pièces (2 chiffres)

Pour les pièces Sur GS1 ils parlement de "pieceoftotal"

https://gs1.github.io/gs1-syntax-dictionary/lint__pieceoftotal_8c.html

Et ce Code:

{
  
 /// \cond
 #define P(i)    data[i]
 #define T(i)    data[len / 2 + i]
 /// \endcond
  
         size_t pos, len, i;
         int pieceiszero, totaliszero, compare;
  
         assert(data);
  
         len = strlen(data);
  
         /*
          * Data must be a non-zero, even number of characters.
          *
          */
         if (len == 0 || len % 2 != 0) {
                 if (err_pos) *err_pos = 0;
                 if (err_len) *err_len = len;
                 return GS1_LINTER_INVALID_LENGTH_FOR_PIECE_OF_TOTAL;
         }
  
         /*
          * Data must consist of all digits.
          *
          */
         if ((pos = strspn(data, "0123456789")) != len) {
                 if (err_pos) *err_pos = pos;
                 if (err_len) *err_len = 1;
                 return GS1_LINTER_NON_DIGIT_CHARACTER;
         }
  
         /*
          * Determine whether either the piece number or total piece count is
          * zero and whether the piece number exceeds the total piece count.
          *
          */
         pieceiszero = totaliszero = 1;
         compare = 0;                            /* -1:P<T ; 0:P==T ; 1:P>T */
         for (i = 0; i < len / 2; i++) {
                 if (pieceiszero && P(i) != '0') pieceiszero = 0;
                 if (totaliszero && T(i) != '0') totaliszero = 0;
                 if (!compare && P(i) != T(i)) compare = P(i) < T(i) ? -1 : 1;
         }
  
         /*
          * Neither piece nor total may be zero.
          *
          */
         if (pieceiszero || totaliszero) {
                 if (err_pos) *err_pos = pieceiszero ? 0 : len / 2;
                 if (err_len) *err_len = len / 2;
                 return pieceiszero ? GS1_LINTER_ZERO_PIECE_NUMBER : GS1_LINTER_ZERO_TOTAL_PIECES;
         }
  
         /*
          * The piece number must not exceed the total piece count.
          *
          */
         if (compare == 1) {
                 if (err_pos) *err_pos = 0;
                 if (err_len) *err_len = len;
                 return GS1_LINTER_PIECE_NUMBER_EXCEEDS_TOTAL;
         }
  
         return GS1_LINTER_OK;
  
 }

Whismeril · Answer

Je ne sais pas trop, mais le but et d'exploiter les données.

Quand tu sauras ce que tu veux en faire, on réfléchira aux façons d'y parvenir.

Le code C que tu donnes, vérifie que le numéro de la pièce n'est pas supérieur au nombre total de pièces et que ces 2 valeurs ne valent pas 0.

NeriXs · Answer

L'objectif de la récupération des data de plus d'un groupe est d'exploiter les informations contenue dans un code-barres et de vérifier l'exactitude de ces données.

Nous avons pu vérifier par exemple l'AI 01 et ça clé de contrôle:

https://codes-sources.commentcamarche.net/forum/affich-10112115-regex-recherche-patten-de-capture-un-defi?page=5#p10112359

Il est possible de récupérer sur cet AI 01 le préfix de compagnie.

En utilisant ce code-barres:

codes = Array ("]d20100884838083332" + Chr(29) + "21DE77659162" + Chr(29) + "240866471" + Chr(29) + "422276" + Chr(29) + "17230419")

Le code:

https://gs1.github.io/gs1-syntax-dictionary/lint__key_8c.html

Permet de générer une url:

https://id.gs1.org/01/00884838083332/21/DE77659162?240=866471&422=276

Cette URL nous dit que la compagnie est (Philips Healthcare).

----------------------------------------

Ensuite nous avons l'AI 422 l'origine.

Elle doit nous permettre de récupérer le nom du pays.

Les codes iso3166, iso3166999, iso3166alpha2 et iso3166list

https://gs1.github.io/gs1-syntax-dictionary/

Ou depuis un CSV:

https://github.com/lukes/ISO-3166-Countries-with-Regional-Codes/blob/master/all/all.csv

La valeur 276 de l'IA 422 de notre code-barres donne: GERMANY

----------------------------------------

Ensuite nous avons l'AI 17 la date d'expiration.

Le code:

https://gs1.github.io/gs1-syntax-dictionary/lint__yymmd0_8c.html

Cela doit nous permettre le formatage de la date:
De 230419 vers 23/04/19 est surtout de vérifier qu'elle est valide.

Au final cela pourrait ressemble à ceci:

Dans certain cas, exemple L'AI 8006 c'est informations font partie de groupes de data supplémentaire.

Whismeril · Answer

Pour traiter les groupes supplémentaires correctement, il faut déjà savoir quel est l'AI.

Du coup, je continue à penser que le plus simple est de redécouper la chaine dans le select case.

Tu ajoutes un attribut à la classe que tu remplis quand c'est nécessaire.

Si tu veux découper dès la regex, il va falloir de prévoir stocker n informations même si beaucoup n'en ont qu'une.

Et de toute façon, il faudra un autre select case pour savoir ce qu'on en fait.

NeriXs · Answer

Après analyse, sur nos 50 groupes de 50 patterns, 39 ont qu'un seul groupe de data.

10 ont 2 groupes de data.

1 seul possède 3 groupes de data et est lié aux AI 8006 et 8026.

Pourrais-tu me faire un exemple de découpage de chaine dans le Select Case?

Par exemple sur:

Select Case AI
        Case "8006"
            madescription = "(8006) ITIP: "
    End Select

Avec la vérification que le numéro de la pièce n'est pas supérieur au nombre total de pièces et que ces 2 valeurs ne valent pas 0.

Ci-dessous les codes avec tous les patterns traités et les Select Case déclarés.

Module:

Function TestNeriXs4(Code As String) As String
Dim fnc1, gs, caracteresOK, pattern, ligne1, ligne2 As String
Dim regex, Match As Object
Dim i As Integer
Dim resultats As Collection
Dim unCode As unCode
Dim boucleOut As Boolean
Dim patterns As New Collection

Set regex = New RegExp

'écriture des patterns unitaires
gs = "(\x1d|GS|$)?" 'quand c'est peut-être
fnc1 = "(\x1d|GS|$|\()" 'quand c'est obligé
caracteresOK = "[\x21\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]"
                 
'Groupe 1
'Balise: 00
'Pattern GS1: ^0(\d{18})$
    patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?\(?(00)$?(\d{18})" + gs
    
'Groupe [2]
'Balise: 01, 02
'Pattern GS1: ^X(\d{14})$
    patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(01|02)$?(\d{14})" + gs
    
'Groupe [3]
'Balise: 10, 21, 22,  243, 254, 420, 710, 711, 712, 713, 714, 715, 4318, 7020, 7021, 7022, 7240, 8002, 8012
'Pattern GS1:  ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,20})$
    patterns.Add "$?(10|2[12]|243|254|520|71[0-5]|4318|702[0-2]|7240|8002|8012)$?(" + caracteresOK + "{0,20})" + fnc1
    
'Groupe [4]
'Balise: 20
'Pattern GS1: ^20(\d{2})$
    patterns.Add "$?(20)$?(\d{2})" + gs
    
'Groupe [5]
'Balise: 235
'Pattern GS1: ^235([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,28})$
    patterns.Add "$?(235)$?(" + caracteresOK + "{0,28})" + fnc1
    
'Groupe [6]
'Balise: 90, 240, 241, 250, 251, 400, 401, 403, 4308, 4319, 7002, 7023, 8004
'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,30})$
    patterns.Add "$?(90|24[0-1]|25[0-1]|40[0-13]|4308|7319|7002|7023|8004)$?(" + caracteresOK + "{0,30})" + fnc1
    
'Groupe [7]
'Balise: 242
'Pattern GS1: ^242(\d{0,6})$
    patterns.Add "$?(242)$?(\d{0,6})" + fnc1
    
'Groupe [8]
'Balise: 253
'Pattern GS1:  ^253(\d{13})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,17})$
    patterns.Add "$?(253)$?(\d{13}" + caracteresOK + "{0,17})" + fnc1
    
'Groupe [9]
'Balise: 255
'Pattern GS1: ^255(\d{13})(\d{0,12})$
    patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(255)$?(\d{13}\d{0,12})" + fnc1
    
'Groupe [10]
'Balise: 30, 37
'Pattern GS1: ^X(\d{0,8})$
    patterns.Add "$?(3[07])$?(\d{0,8})" + fnc1
    
'Groupe [11]
'Balise: 11, 12, 13, 15, 16, 17
'        3100 à 3105, 3110 à 3115, 3120 à 3125, 3130 à 3135, 3140 à 3145, 3150 à 3155, 3160 à 3165,
'        3300 à 3305, 3310 à 3315, 3320 à 3325, 3330 à 3335, 3340 à 3345, 3350 à 3355, 3360 à 3365, 3370 à 3375,
'        3500 à 3505, 3510 à 3515, 3520 à 3525, 3530 à 3535, 3540 à 3545, 3550 à 3555, 3560 à 3565, 3570 à 3575,
'        3200 à 3205, 3210 à 3215, 3220 à 3225, 3230 à 3235, 3240 à 3245, 3250 à 3255, 3260 à 3265, 3270 à 3275, 3280 à 3285, 3290 à 3295,
'        3400 à 3405, 3410 à 3415, 3420 à 3425, 3430 à 3435, 3440 à 3445, 3450 à 3455, 3460 à 3465, 3470 à 3475, 3480 à 3485, 3490 à 3495,
'        3600 à 3605, 3610 à 3615, 3620 à 3625, 3630 à 3635, 3640 à 3645, 3650 à 3655, 3660 à 3665, 3670 à 3675, 3680 à 3685, 3690 à 3695,
'Pattern GS1:^11(\d{6})$
    patterns.Add "$?(1[123567]|31[0-6][0-5]|3[35][0-7][0-5]|3[246]\d[0-5])$?(\d{6})" + gs
    
'Groupe [12]
'Balise: 7007
'Pattern GS1:  ^7007(\d{6,12})$
    patterns.Add "$?(7007)$?(\d{6,12})" + fnc1
    
'Groupe [13]
'Balise: 7011
'Pattern GS1:  ^7011(\d{6})(\d{0,4})$
    patterns.Add "$?(7011)$?(\d{6}\d{0,4})" + fnc1
    
'Groupe [14]
'Balise: 3900 à 3909, 3920 à 3929
'Pattern GS1: ^X(\d{0,15})$
    patterns.Add "$?(390[0-9]|392[0-9])$?(\d{0,15})" + fnc1
    
'Groupe [15]
'Balise: 3910 à 3919, 3930 à 3939
'Pattern GS1: ^X(\d{3})(\d{0,15})$
    patterns.Add "$?(391[0-9]|393[0-9])$?(\d{3}\d{0,15})" + fnc1
    
'Groupe [16]
'Balise: 3940 à 3943, 8111
'Pattern GS1: ^X(\d{4})$
    patterns.Add "$?(394[0-3]|8111)$?(\d{4})" + fnc1
    
'Groupe [17]
'Balise: 3950 à 3959
'Pattern GS1: ^X(\d{0,6})$
    patterns.Add "$?(395[0-9])$?(\d{0,6})" + fnc1
    
'Groupe [18]
'Balise: 402
'Pattern GS1: ^402(\d{17})$
    patterns.Add "$?(402)$?(\d{17})" + fnc1
    
'Groupe [19]
'Balise: 421
'Pattern GS1:^421(\d{3})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,9})$
    patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(421)$?(\d{3}" + caracteresOK + "{0,9})" + fnc1
    
'Groupe [20]
'Balise: 422, 424, 426
'Pattern GS1:  ^X(\d{3})$
    patterns.Add "$?(42[246])$?(\d{3})" + fnc1
    
'Groupe [21]
'Balise: 423, 425
'Pattern GS1: ^X(\d{3})(\d{0,12})$
    patterns.Add "$?(423|425)$?(\d{3}\d{0,12})" + fnc1
    
'Groupe [22]
'Balise: 427, 7008
'Pattern GS1:  ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,3})$
    patterns.Add "$?(427|7008)$?(" + caracteresOK + "{0,3})" + fnc1
    
'Groupe [23]
'Balise: 4300, 4301, 4310, 4311, 4320
'Pattern GS1:  ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,35})$
    patterns.Add "$?(430[01]|431[01]|4320)$?(" + caracteresOK + "{0,35})" + fnc1
    
'Groupe [24]
'Balise: 4302 à 4306, 4312 à 4316, 8110, 8112, 8200
'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,70})$
    patterns.Add "$?(430[23456]|431[23456]|811[02]|8200)$?(" + caracteresOK + "{0,70})" + fnc1
    
'Groupe [25]
'Balise: 4307, 4317
'Pattern GS1: ^X([A-Z]{2})$
    patterns.Add "$?(4307|4317)$?([A-Z]{2})" + fnc1
    
'Groupe [26]
'Balise: 7230 à 7239
'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{2,30})$
    patterns.Add "$?(723[0-9])$?(" + caracteresOK + "{2,30})" + fnc1
    
'Groupe [27]
'Balise: 4309
'Pattern GS1: ^4309(\d{20})$
    patterns.Add "$?(4309)$?(\d{20})" + fnc1
    
'Groupe [28]
'Balise: 4321, 4322, 4323
'Pattern GS1: ^X([01])$
    patterns.Add "$?(432[123])$?([01])" + fnc1
    
'Groupe [29]
'Balise: 4324, 4325, 7003
'Pattern GS1:  ^X(\d{10})$
    patterns.Add "$?(432[45]|7003)$?(\d{10})" + fnc1
    
'Groupe [30]
'Balise: 4326, 7006, 8005
'Pattern GS1: ^X(\d{6})$
    patterns.Add "$?(4326|7006|8005)$?(\d{6})" + fnc1
    
'Groupe [31]
'Balise: 7001
'Pattern GS1: ^7001(\d{13})$
    patterns.Add "$?(7001)$?(\d{13})" + fnc1
    
'Groupe [32]
'Balise: 7004
'Pattern GS1: ^7004(\d{0,4})$
    patterns.Add "$?(7004)$?(\d{0,4})" + fnc1
    
'Groupe [33]
'Balise: 410 à 417
'Pattern GS1: ^X(\d{13})$
    patterns.Add "$?(41[0-7])$?(\d{13})" + gs
    
'Groupe [34]
'Balise: 7005
'Pattern GS1: ^7005([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,12})$
    patterns.Add "$?(7005)$?(" + caracteresOK + "{0,12})" + fnc1
    
'Groupe [35]
'Balise: 8006, 8026
'Pattern GS1: ^X(\d{14})(\d{2})(\d{2})$
    patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8006|8026)$?(\d{14}\d{2}\d{2})" + fnc1
    'patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8006|8026)$?(\d{14})(\d{2})(\d{2})" + fnc1
    
'Groupe [36]
'Balise: 8007
'Pattern GS1: ^8007([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,34})$
    patterns.Add "$?(8007)$?(" + caracteresOK + "{0,34})" + fnc1
    
'Groupe [37]
'Balise: 8008
'Pattern GS1: ^8008(\d{8})(\d{0,4})$
    patterns.Add "$?(8007)$?(\d{8}\d{0,4})" + fnc1
    
'Groupe [38]
'Balise: 8009
'Pattern GS1: ^8009([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,50})$
    patterns.Add "$?(8009)$?(" + caracteresOK + "{0,50})" + fnc1
    
'Groupe [39]
'Balise: 8010
'Pattern GS1:  ^8010([\x23\x2D\x2F\x30-\x39\x41-\x5A]{5,30})$
    patterns.Add "$?(8010)$?([\x23\x2D\x2F\x30-\x39\x41-\x5A]{5,30})" + fnc1
    
'Groupe [40]
'Balise: 7009
'Pattern GS1: ^7009([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,10})$
    patterns.Add "$?(7009)$?(" + caracteresOK + "{0,10})" + fnc1
    
'Groupe [41]
'Balise: 7010
'Pattern GS1: ^7010([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,2})$
    patterns.Add "$?(7010)$?(" + caracteresOK + "{0,2})" + fnc1
    
'Groupe [42]
'Balise: 7040
'Pattern GS1: ^7040(\d[\x21-\x22\x25-\x2F\x30-\x39\x41-\x5A\x5F\x61-\x7A]{3})$
    patterns.Add "$?(7040)$?(\d[\x21\x22\x25-\x2F\x30-\x39\x41-\x5A\x5F\x61-\x7A]{3})" + fnc1
    
'Groupe [43]
'Balise: 8011
'Pattern GS1: ^8011(\d{0,12})$
    patterns.Add "$?(8011)$?(\d{0,12})" + fnc1
    
'Groupe [44]
'Balise:  7030 à 7039
'Pattern GS1: ^X(\d{3})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,27})$
    patterns.Add "$?(703[0-9])$?(\d{3}" + caracteresOK + "{0,27})" + fnc1

'Groupe [45]
'Balise: 8001
'Pattern GS1: ^8001(\d{14})$
    patterns.Add "$?(8001)$?(\d{14})" + fnc1
    
'Groupe [46]
'Balise: 8003
'Pattern GS1: ^8003(\d{14})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,16})$
    patterns.Add "$?(8003)$?(\d{14}" + caracteresOK + "{0,16})" + fnc1
   
'Groupe [47]
'Balise: 8013, 8020
'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,25})$
    patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8013|8020)$?(" + caracteresOK + "{0,25})" + fnc1
    
'Groupe [48]
'Balise: 8017, 8018
'Pattern GS1: ^X(\d{18})$
    patterns.Add "$?(801[78])$?(\d{18})" + fnc1
    
'Groupe [50]
'Balise: 91 à 99
'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,90})$
    patterns.Add "$?(9[1-9])$?(" + caracteresOK + "{0,90})" + fnc1

'valeur par défaut si la regex ne matche pas
ligne1 = "Code incorrect"
ligne2 = ""
Set resultats = New Collection

Do
    boucleOut = False
    For Each pattern In patterns
        'on teste chaque pattern pour le début du code
        regex.pattern = "^" + pattern
        If (regex.Test(Code)) Then
            boucleOut = True
            ligne1 = ""
            'si ça marche, on extrait la partie
            Set Match = regex.Execute(Code)(0)
    
            Set unCode = New unCode
            unCode.Init Match.SubMatches(0), Match.SubMatches(1)
            resultats.Add unCode
            
            'on enlève ce qu'on vient de traiter
            Code = Replace(Code, Match.Value, "")
            
            'et on recommence
            Exit For
        End If
    Next
    
Loop While Len(Code) > 0 And boucleOut 'si boucleOut vaut false c'est qu'on vient de faire un tour complet et qu'on est sur un cas imprévu

If boucleOut = False Then
    ligne1 = "Erreur data imprévue" + vbCrLf
End If

For i = 1 To resultats.Count
    Set unCode = resultats(i)
    ligne1 = ligne1 + unCode.Texte
    ligne2 = ligne2 + vbCrLf + unCode.Description
Next
TestNeriXs4 = ligne1 + ligne2
End Function

Sub Test()
Dim codes() As Variant
Dim Code As Variant

'# "req=01,02,8006,8026" - Association obligatoire avec l'une des IA énumérées.
'# "ex=02,255,37" - association non valable avec l'un des IA énumérés.
'# "dlpkey" - Clé primaire de la liaison numérique GS1.
'#          - "https:///01/../10/../22/..".
'# "dlpkey" - Non prit en charge dans ce projet.

'# "X" = [\x21\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A] ---> GS1
'        [\x21-\x22\x25-\x3F\x41-\x5A\x5F\x61-\x7A]

'# "Y" = [\x23\x2D\x2F\x30-\x39\x41-\x5A]] ---> GS1 ---> AI 8010

'# "UIC" = [\x21-\x22\x25-\x2F\x30-\x39\x41-\x5A\x5F\x61-\x7A] ---> GS1 ---> AI 7040
'          [\x21\x22\x25-\x39\x5F\x61-\x7A]

'codes = Array("010084399701370311210601363012345617230601213000105704" + Chr(29) + "3233123456", _
'              "(01)00843997013703(11)210601(3630)123456(17)230601(21)3000105704" + Chr(29) + "(3233)123456", _
'              "(01)00843997013703(02)00843997013703(11)210601(17)230601(21)3000105704", _
'              "010088483808258823543522TTs" + Chr(29) + "21DE7840AL79" + Chr(29) + "91867031", _
'              "010733241412435925330000400220140123456789" + Chr(29) + "210000107668" + Chr(29) + "11210208", _
'              "(01)00843997013703(11)210601(17)230601(10)54gp75P(21)3000105704", _
'              "(01)00843997013703(11)210601(10)54gp75P(17)230601(21)3000105704", _
'              "]C101008838738677920200843997013703112207071723070710220707" + Chr(29) + "21PC22412085", _
'              "010088483808258824254321" + Chr(29) + "21DE7840AL82" + Chr(29) + "90867030" + Chr(29) + "91867030" _
'              )

'AI:00 - N18, CheckSum clé de contrôle, GCP (GS1 Company Prefix).
'codes = Array("]C100123456789123456789")
               
'AI:01 - N14, CheckSum clé de contrôle, GCP (GS1 Company Prefix), ex=02,255,37.
'codes = Array("]C10112345678912343")
               
'AI:02 - N14, CheckSum clé de contrôle, GCP (GS1 Company Prefix), req=37.
'codes = Array("]C10012345678912345678902123456789123433712345")
              
' 253
'codes = Array("]C1010733241412435925310000400220167TTb3456789" + Chr(29) + "210000107668" + Chr(29) + "11210208", _
'              "]d201073324141243592532800040022011123456789" + Chr(29) + "210000107668" + Chr(29) + "11210208", _
'              "00395011010013000129403123+1021JK+0320+12" + Chr(29) + "4215281500KM" _
'              )
              
'255, 17, 3902, 90
'codes = Array("2553453120000127" + Chr(29) + "1715030439020500" + Chr(29) + "9001")

'8020, 3910, 415
'codes = Array("]C18020AZERTY123456qerty12345678" + Chr(29) + "3910008012345678901234" + Chr(29) + "4151234567891231", _
'              "8020AZERTY123456qerty12345678" + Chr(29) + "3910008012345678901234" + Chr(29) + "4151234567891231", _
'              "41512345678912318020AZERTY123456qerty12345678" + Chr(29) + "3910008012345678901234", _
'              "8020AZERTY123456qerty12345678" + Chr(29) + "41512345678912313910008012345678901234", _
'              "3910008012345678901234" + Chr(29) + "8020AZERTY123456qerty12345678" + Chr(29) + "4151234567891231" _
'              )

'codes = Array("]d20100884838083332" + Chr(29) + "21DE77659162" + Chr(29) + "240866471" + Chr(29) + "422276")

'01, 7007 = AI 01 + 2 Dates, ex 21/05/19 22/04/01 AAMMjj
'codes = Array("01073324141243597007210519220401")
              
'01, 7011 = Ai 01 + date + heure, ex 31/05/19 22:04
'codes = Array("010733241412435970112105192204")

'01, 426, 7030
'codes = Array("]C101073324141243594262507030250987654")

'00, 403, 421
'codes = Array("00395011010013000129403123+1021JK+0320+12" + Chr(29) + "4215281500KM")
'codes = Array("]C142127640219")

'00,8006
codes = Array("]C1003950110153000000118006095011015300270203")

'01, 253, 21, 11
'codes = Array("010733241412435925312345678912345" + Chr(29) + "210000107668" + Chr(29) + "11210208")
'codes = Array("]C180068006008439970137030303")
'codes = Array("]C100123456789012345678")
'codes = Array("]C10200843997013703")

For Each Code In codes
    Debug.Print (Code)
    Debug.Print (TestNeriXs4(CStr(Code)))
    Debug.Print ("")
Next
End Sub

Module de classe (unCode)

'Champs utiles
Public AI As String

Public Code As String

'Initialise l'instance de l'objet UnCode
Public Sub Init(LaBalise As String, LeCode As String)
    AI = LaBalise
    Code = LeCode
End Sub

'Méthode qui retourne un texte sous la forme "(Balise)LeCode"
Public Function Texte() As String
    Texte = "(" & AI & ")" & Code
End Function

'Méthode qui retourne un texte sous la forme "(Balise) Description : LeCode"
Public Function Description() As String
    Dim madescription As String
    
    Select Case AI
        Case "00"
            madescription = "(00) N° CONTENEUR (SSCC): "
    
        Case "01"
            madescription = "(01) N° ARTICLE (GTIN): "
            
        Case "02"
            madescription = "(02) N° ARTICLES CONTENUS: "
            
        Case "10"
            madescription = "(10) N° LOT: "
    
        Case "11"
            madescription = "(11) DATE PRODUCTION: "
            
        Case "12"
            madescription = "(12) DATE ECHEANCE: "

Case "13"
            madescription = "(13) DATE EMBALLAGE: "

Case "15"
            madescription = "(15) DATE PREREMPTION: "

Case "16"
            madescription = "(16) DATE VENTE: "
            
        Case "17"
            madescription = "(17) DATE EXPIRATION: "
            
        Case "20"
            madescription = "(20) VARIANTE ARTICLE: "
            
        Case "21"
            madescription = "(21) N° SÉRIE: "
            
        Case "22"
            madescription = "(22) VARIANTE PRODUIT: "

Case "235"
            madescription = "(235) EXTANSION CONTROLE: "

Case "240"
            madescription = "(240) ID ADDITIONNEL: "

Case "241"
            madescription = "(241) N° PIECE: "

Case "242"
            madescription = "(242) N° VARATION: "

Case "243"
            madescription = "(243) N° EMBALAGE: "

Case "250"
            madescription = "(250) N° SÉRIE SECONDAIRE: "

Case "251"
            madescription = "(251) REF SOURCE: "

Case "253"
            madescription = "(253) IDENTIFICATEUR DOC (GDTI): "

Case "254"
            madescription = "(254) COMPOSANT EXTENSION (GLN): "

Case "255"
            madescription = "(255) N° COUPON (GCN): "
            
        Case "30"
            madescription = "(30) NB VARIABLE ARTICLES: "
            
        Case "37"
            madescription = "(37) COMPTAGE UNITÉ, log: "
            
        Case "3100", "3101", "3102", "3103", "3104", "3105"
            madescription = "(" + AI + ") POIDS NET (kg): "

Case "3110", "3111", "3112", "3113", "3114", "3115"
            madescription = "(" + AI + ") LONGUEUR (m): "

Case "3120", "3121", "3122", "3123", "3124", "3125"
            madescription = "(" + AI + ") LARGEUR (m): "

Case "3130", "3131", "3132", "3133", "3134", "3135"
            madescription = "(" + AI + ") HAUTEUR (m): "

Case "3140", "3141", "3142", "3143", "3144", "3145"
            madescription = "(" + AI + ") SUPERFICIE (m²): "

Case "3150", "3151", "3152", "3153", "3154", "3155"
            madescription = "(" + AI + ") VOLUME NET (l): "

Case "3160", "3161", "3162", "3163", "3164", "3165"
            madescription = "(" + AI + ") VOLUME NET (m³): "

Case "3200", "3201", "3202", "3203", "3204", "3205"
            madescription = "(" + AI + ") POIDS NET (lb): "

Case "3210", "3211", "3212", "3213", "3214", "3215"
            madescription = "(" + AI + ") LONGUEUR (in): "

Case "3220", "3221", "3222", "3223", "3224", "3225"
            madescription = "(" + AI + ") LONGUEUR (ft): "

Case "3230", "3231", "3232", "3233", "3234", "3235"
            madescription = "(" + AI + ") LONGUEUR (yd): "

Case "3240", "3241", "3242", "3243", "3244", "3245"
            madescription = "(" + AI + ") LARGEUR (in): "

Case "3250", "3251", "3252", "3253", "3254", "3255"
            madescription = "(" + AI + ") LARGEUR (ft): "

Case "3260", "3261", "3262", "3263", "3264", "3265"
            madescription = "(" + AI + ") LARGEUR (yd): "

Case "3270", "3271", "3272", "3273", "3274", "3275"
            madescription = "(" + AI + ") HAUTEUR (in): "

Case "3280", "3281", "3282", "3283", "3284", "3285"
            madescription = "(" + AI + ") HAUTEUR (ft): "

Case "3290", "3291", "3292", "3293", "3294", "3295"
            madescription = "(" + AI + ") HAUTEUR (yd): "
            
        Case "3300", "3301", "3302", "3303", "3304", "3305"
            madescription = "(" + AI + ") POIDS BRUT (kg): "

Case "3310", "3311", "3312", "3313", "3314", "3315"
            madescription = "(" + AI + ") LONGUEUR (m), log: "

Case "3320", "3321", "3322", "3323", "3324", "3325"
            madescription = "(" + AI + ") LARGEUR (m), grume: "

Case "3330", "3331", "3332", "3333", "3334", "3335"
            madescription = "(" + AI + ") HAUTEUR (m), grume: "

Case "3340", "3341", "3342", "3343", "3344", "3345"
            madescription = "(" + AI + ") SUPERFICIE (m²), log: "

Case "3350", "3351", "3352", "3353", "3354", "3355"
            madescription = "(" + AI + ") VOLUME (l), log: "

Case "3360", "3361", "3362", "3363", "3364", "3365"
            madescription = "(" + AI + ") VOLUME (m³), log: "

Case "3370", "3371", "3372", "3373", "3374", "3375"
            madescription = "(" + AI + ") KG PAR m²: "
            
        Case "3400", "3401", "3402", "3403", "3404", "3405"
            madescription = "(" + AI + ") POIDS BRUT (lb): "

Case "3410", "3411", "3412", "3413", "3414", "3415"
            madescription = "(" + AI + ") LONGUEUR (po), bille: "

Case "3420", "3421", "3422", "3423", "3424", "3425"
            madescription = "(" + AI + ") LONGUEUR (ft), bille: "

Case "3430", "3431", "3432", "3433", "3434", "3435"
            madescription = "(" + AI + ") LONGUEUR (yd), bille: "

Case "3440", "3441", "3442", "3443", "3444", "3445"
            madescription = "(" + AI + ") LARGEUR (po), grume: "

Case "3450", "3451", "3452", "3453", "3454", "3455"
            madescription = "(" + AI + ") LARGEUR (ft), grume: "

Case "3460", "3461", "3462", "3463", "3464", "3465"
            madescription = "(" + AI + ") LARGEUR (yd), grume: "

Case "3470", "3471", "3472", "3473", "3474", "3475"
            madescription = "(" + AI + ") HAUTEUR (po), grume: "

Case "3480", "3481", "3482", "3483", "3484", "3485"
            madescription = "(" + AI + ") HAUTEUR (ft), grume: "

Case "3490", "3491", "3492", "3493", "3494", "3495"
            madescription = "(" + AI + ") HAUTEUR (yd), grume: "
            
        Case "3500", "3501", "3502", "3503", "3504", "3505"
            madescription = "(" + AI + ") SUPERFICIE (in²): "

Case "3510", "3511", "3512", "3513", "3514", "3515"
            madescription = "(" + AI + ") SURFACE (pi²): "

Case "3520", "3521", "3522", "3523", "3524", "3525"
            madescription = "(" + AI + ") SUPERFICIE (yd²): "

Case "3530", "3531", "3532", "3533", "3534", "3535"
            madescription = "(" + AI + ") SUPERFICIE (in²), log: "

Case "3540", "3541", "3542", "3543", "3544", "3545"
            madescription = "(" + AI + ") SUPERFICIE (pi²), log: "

Case "3550", "3551", "3552", "3553", "3554", "3555"
            madescription = "(" + AI + ") SUPERFICIE (yd²), log: "

Case "3560", "3561", "3562", "3563", "3564", "3565"
            madescription = "(" + AI + ") POIDS NET (t oz): "

Case "3570", "3571", "3572", "3573", "3574", "3575"
            madescription = "(" + AI + ") VOLUME NET (oz): "

Case "3600", "3601", "3602", "3603", "3604", "3605"
            madescription = "(" + AI + ") VOLUME NET (qt): "

Case "3610", "3611", "3612", "3613", "3614", "3615"
            madescription = "(" + AI + ") VOLUME NET (gal.): "

Case "3620", "3621", "3622", "3623", "3624", "3625"
            madescription = "(" + AI + ") VOLUME (qt), log: "

Case "3630", "3631", "3632", "3633", "3634", "3635"
            madescription = "(" + AI + ") VOLUME (gal.), log: "

Case "3640", "3641", "3642", "3643", "3644", "3645"
            madescription = "(" + AI + ") VOLUME (po³): "

Case "3650", "3651", "3652", "3653", "3654", "3655"
            madescription = "(" + AI + ") VOLUME (pi³): "

Case "3660", "3661", "3662", "3663", "3664", "3665"
            madescription = "(" + AI + ") VOLUME (yd³): "

Case "3670", "3671", "3672", "3673", "3674", "3675"
            madescription = "(" + AI + ") VOLUME (po³), bille: "

Case "3680", "3681", "3682", "3683", "3684", "3685"
            madescription = "(" + AI + ") VOLUME (pi³), rondin: "

Case "3690", "3691", "3692", "3693", "3694", "3695"
            madescription = "(" + AI + ") VOLUME (yd³), log: "
            
        Case "3900", "3901", "3902", "3903", "3904", "3905", "3906", "3907", "3908", "3909"
            madescription = "(" + AI + ") MONTANT: "

Case "3910", "3911", "3912", "3913", "3914", "3915", "3916", "3917", "3918", "3919"
            madescription = "(" + AI + ") MONTANT (ISO): "

Case "3920", "3921", "3922", "3923", "3924", "3925", "3926", "3927", "3928", "3929"
            madescription = "(" + AI + ") PRIX: "

Case "3930", "3931", "3932", "3933", "3934", "3935", "3936", "3937", "3938", "3939"
            madescription = "(" + AI + ") PRIX (ISO): "

Case "3940", "3941", "3942", "3943"
            madescription = "(" + AI + ") REMISE %: "

Case "3950", "3951", "3952", "3953", "3954", "3955"
            madescription = "(" + AI + ") PRIX / UoM: "
            
        Case "400"
            madescription = "(400) NUMÉRO DE COMMANDE: "

Case "401"
            madescription = "(401) N° INDENTIFICATION (GINC): "

Case "402"
            madescription = "(402) N° INDENTIFICATION (GSIN): "

Case "403"
            madescription = "(403) CODE ROUTAGE: "

Case "410"
            madescription = "(410) EXPÉDIER À: "

Case "411"
            madescription = "(411) FACTURER À: "

Case "412"
            madescription = "(412) ACHAT AUPRÈS DE: "

Case "413"
            madescription = "(413) EXPÉDIER POUR: "

Case "414"
            madescription = "(414) N° LOC: "

Case "415"
            madescription = "(415) PAYER À: "

Case "416"
            madescription = "(416) PROD/SERV LOC: "

Case "417"
            madescription = "(417) PARTIE: "

Case "420"
            madescription = "(420) EXPÉDIER CODE POSTAL: "

Case "421"
            madescription = "(421) EXPÉDIER CODE POSTAL (ISO): "

Case "422"
            madescription = "(422) ORIGINE: "

Case "423"
            madescription = "(423) PROCESSUS INITIAL: "

Case "424"
            madescription = "(424) PAYS - PROCESSUS: "

Case "425"
            madescription = "(425) PAYS - DÉSASSEMBLAGE: "

Case "426"
            madescription = "(426) PAYS - PROCESSUS COMPLET: "

Case "427"
            madescription = "(427) SUBDIVISION ORIGINE: "
            
        Case "4300"
            madescription = "(4300) ENVOYER À SOCIÉTÉ: "

Case "4301"
            madescription = "(4301) ENVOYER AU NOM: "

Case "4302"
            madescription = "(4302) ENVOYER À ADD1: "

Case "4303"
            madescription = "(4303) ENVOYER À ADD2: "

Case "4304"
            madescription = "(4304) ENVOYER À BANLIEUE: "

Case "4305"
            madescription = "(4305) ENVOYER À LOC: "

Case "4306"
            madescription = "(4306) ENVOYER VERS REG: "

Case "4307"
            madescription = "(4307) ENVOYER AU PAYS: "

Case "4308"
            madescription = "(4308) ENVOYER AU TÉLÉPHONE: "

Case "4309"
            madescription = "(4309) ENVOI VERS GEO: "

Case "4310"
            madescription = "(4310) RETOUR À SOCIÉTÉ: "

Case "4311"
            madescription = "(4311) RETOUR AU NOM: "

Case "4312"
            madescription = "(4312) RETOUR À ADD1: "

Case "4313"
            madescription = "(4313) RETOUR À ADD2: "

Case "4314"
            madescription = "(4314) RETOUR EN BANLIEUE: "

Case "4315"
            madescription = "(4315) RETOUR À LOC: "

Case "4316"
            madescription = "(4316) RETOUR À REG: "

Case "4317"
            madescription = "(4317) RETOUR AU PAYS: "

Case "4318"
            madescription = "(4318) RETOUR CODE POSTAL: "

Case "4319"
            madescription = "(4319) RETOUR AU TÉLÉPHONE: "

Case "4320"
            madescription = "(4320) DESCRIPTION DU SERVICE: "

Case "4321"
            madescription = "(4321) MARCHANDISES DANGEREUSES: "

Case "4322"
            madescription = "(4322) AUTORISATION DE SORTIE: "

Case "4323"
            madescription = "(4323) SIGNATURE REQUIS: "

Case "4324"
            madescription = "(4324) PAS AVANT DATE: "

Case "4325"
            madescription = "(4325) PAS APRES DATE: "

Case "4326"
            madescription = "(4326) DATE DE SORTIE: "
            
        Case "7001"
            madescription = "(7001) N° STOCK OTAN (NSN): "

Case "7002"
            madescription = "(7002) DÉCOUPE DE VIANDE: "

Case "7003"
            madescription = "(7003) DATE DE PÉREMPTION: "

Case "7004"
            madescription = "(7004) PUISSANCE ACTIVE: "

Case "7005"
            madescription = "(7005) ZONE DE CAPTURE: "

Case "7006"
            madescription = "(7006) DATE DE PREMIERE CONGELATION: "

Case "7007"
            madescription = "(7007) DATE DE RÉCOLTE: "

Case "7008"
            madescription = "(7008) ESPÈCES AQUATIQUES: "

Case "7009"
            madescription = "(7009) TYPE D'ENGIN DE PÊCHE: "

Case "7010"
            madescription = "(7010) MÉTHODE DE PRODUCTION: "

Case "7011"
            madescription = "(7011) DATE LIMITE D'ESSAI: "

Case "7020"
            madescription = "(7020) RÉNOVATION LOT: "

Case "7021"
            madescription = "(7021) STATUS FONCTIONNEL: "

Case "7022"
            madescription = "(7022) STATUS RÉVISION: "

Case "7023"
            madescription = "(7023) ID ASSEMBLAGE(GIAI): "

Case "7030"
            madescription = "(7030) PROCESSEUR ISO # 0: "

Case "7031"
            madescription = "(7031) PROCESSEUR ISO # 1: "

Case "7032"
            madescription = "(7032) PROCESSEUR ISO # 2: "

Case "7033"
            madescription = "(7033) PROCESSEUR ISO # 3: "

Case "7034"
            madescription = "(7034) PROCESSEUR ISO # 4: "

Case "7035"
            madescription = "(7035) PROCESSEUR ISO # 5: "

Case "7036"
            madescription = "(7036) PROCESSEUR ISO # 6: "

Case "7037"
            madescription = "(7037) PROCESSEUR ISO # 7: "

Case "7038"
            madescription = "(7038) PROCESSEUR ISO # 8: "

Case "7039"
            madescription = "(7039) PROCESSEUR ISO # 9: "

Case "7040"
            madescription = "(7040) UIC+EXT: "
            
        Case "710"
            madescription = "(710) NHRN PZN: "

Case "711"
            madescription = "(711) NHRN CIP: "

Case "712"
            madescription = "(712) NHRN CN: "

Case "713"
            madescription = "(713) NHRN DRN: "

Case "714"
            madescription = "(714) NHRN AIM: "

Case "715"
            madescription = "(715) NHRN NDC: "
            
        Case "7230"
            madescription = "(7230) CERT # 1: "

Case "7231"
            madescription = "(7231) CERT # 2: "

Case "7232"
            madescription = "(7232) CERT # 3: "

Case "7233"
            madescription = "(7233) CERT # 4: "

Case "7234"
            madescription = "(7234) CERT # 5: "

Case "7235"
            madescription = "(7235) CERT # 6: "

Case "7236"
            madescription = "(7236) CERT # 7: "

Case "7237"
            madescription = "(7237) CERT # 8: "

Case "7238"
            madescription = "(7238) CERT # 9: "

Case "7239"
            madescription = "(7239) CERT # 10: "

Case "7240"
            madescription = "(7240) PROTOCOLE: "

Case "7241"
            madescription = "(7241) TYPE DE SUPPORT AIDC: "

Case "7242"
            madescription = "(7242) VCN: "
            
        Case "8001"
            madescription = "(8001) DIMENSIONS: "

Case "8002"
            madescription = "(8002) CMT No.: "

Case "8003"
            madescription = "(8003) GRAI: "

Case "8004"
            madescription = "(8004) GIAI: "

Case "8005"
            madescription = "(8005) PRIX PAR UNITÉ: "

Case "8006"
            madescription = "(8006) ITIP: "

Case "8007"
            madescription = "(8007) IBAN: "

Case "8008"
            madescription = "(8008) HEURE PRODUCTION: "

Case "8009"
            madescription = "(8009) OPTSEN: "

Case "8010"
            madescription = "(8010) CPID: "

Case "8011"
            madescription = "(8011) CPID SERIE: "

Case "8012"
            madescription = "(8012) VERSION: "

Case "8013"
            madescription = "(8012) GMN: "

Case "8017"
            madescription = "(8017) GSRN - PRESTATAIRE: "

Case "8018"
            madescription = "(8018) GSRN - DESTINATAIRE: "

Case "8019"
            madescription = "(8019) SRIN: "

Case "8020"
            madescription = "(8020) REF No.: "

Case "8026"
            madescription = "(8026) CONTENU ITIP: "

Case "8030"
            madescription = "(8030) DIGSIG: "

Case "8110"
            madescription = "(8110) CODE COUPON: "

Case "8111"
            madescription = "(8111) POINTS: "

Case "8112"
            madescription = "(8112) ID COUPON: "

Case "8200"
            madescription = "(8200) URL DU PRODUIT: "
            
        Case "90"
            madescription = "(90) INTERNE MUTUELLE: "

Case "91", "92", "93", "94", "95", "96", "97", "98", "99"
            madescription = "(" + AI + ") N° INTERNE: "
                   
        Case Else
            madescription = "(" + AI + ") Déscription non codée : "
            
    End Select
           
    Description = madescription + Code
End Function

Whismeril · Answer

Avec un minimum de modif (et donc dans ce premier jet pas la présentation que tu as donnée précédemment)

La classe

'Champs utiles
Public AI As String

Public Code As String

Public ValidationData As Boolean

'Initialise l'instance de l'objet UnCode
Public Sub Init(LaBalise As String, leCode As String)
    AI = LaBalise
    Code = leCode
End Sub

'Méthode qui retourne un texte sous la forme "(Balise)LeCode"
Public Function Texte() As String
    Texte = "(" & AI & ")" & Code
End Function

'Méthode qui retourne un texte sous la forme "(Balise) Description : LeCode"
Public Function Description() As String
    Dim madescription As String
    Dim leCode As String
    leCode = Code
    
    ValidationData = True
    
    Select Case AI
        Case "01"
            madescription = "(01) GTIN de l’article: "
    
        Case "11"
            madescription = "(11) Date de production: "
            
        Case "17"
            madescription = "(17) Date d'expiration : "
            
        Case "10"
            madescription = "(10) Numéro de lot: "
            
        Case "21"
            madescription = "(21) Numéro de série: "
        
        Case "91"
            madescription = "(91) InfosInternes: "
            
        Case "8006"
            Dim data As String
            Dim numero, totalSerie As Integer
            
            madescription = "(8006) ITIP: "
            
            data = Left(Code, 14)
            If CheckSum(data) Then
                leCode = data + ", checksum OK | "
            Else
                leCode = "erreur checksum, " + data + " | "
                ValidationData = False
            End If
            
            numero = CInt(Mid(Code, 15, 2))
            totalSerie = CInt(Right(Code, 2))
            
            If numero = 0 Or totalSerie = 0 Or numero > totalSerie Then
                leCode = leCode + "Erreur de numérotation, "
                ValidationData = False
            End If
            leCode = leCode + "numéro de la pièce dans la série : " + CStr(numero) + ", nombre de pièces dans la série : " + CStr(totalSerie)

Case Else
            madescription = "(" + AI + ") Déscription non codée : "
            
    End Select
           
    Description = madescription + leCode
End Function

Function CheckSum(data As String) As Boolean
    Dim s, key As Integer
    s = 0
    Dim f As Integer
    Dim valeur As Variant
    
    key = CInt(Right(data, 1)) 'la clé c'est le carractère de droite
    valeur = Left(data, Len(data) - 1) 'la valeur c'est le reste
    
    'facteur de départ en fonction de la longeur de la valeur
    If Len(valeur) Mod 2 = 0 Then
        f = 1
    Else
        f = 3
    End If
    
    For i = 1 To Len(valeur)
        s = s + CInt(Mid(valeur, i, 1)) * f
        f = 4 - f
    Next i
    
    'on vérifie si la clé est bonne
    If s Mod 10 = 0 Then
        CheckSum = (key = 0)
    Else
        CheckSum = (key = 10 - s Mod 10)
    End If
    
End Function

Une modif à la fin de TestNeriXs4

'...tout le début idem

Dim ValidationData As Boolean
ValidationData = True 'par défaut on considère que tout est correct
For i = 1 To resultats.Count
    Set unCode = resultats(i)
    ligne1 = ligne1 + unCode.Texte
    ligne2 = ligne2 + vbCrLf + unCode.Description
    If unCode.ValidationData = False Then 's'il y a au moins une data incorrecte ça sera signalé
        ValidationData = False
    End If
Next
If ValidationData = False Then
    ligne2 = vbCrLf + vbCrLf + "Attention ça c'est mal passé !" + vbCrLf + ligne2
End If

TestNeriXs4 = ligne1 + ligne2
End Function

Le code de test

Sub test()
Dim codes() As Variant
Dim Code As Variant
'mise de plusieurs codes de test dans un tableau
codes = Array("(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012315678", _
              "(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012345678", _
              "(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012310078", _
              "(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012315600", _
              "(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012317856", _
              "(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012347856")

For Each Code In codes
    Debug.Print (Code)
    Debug.Print (TestNeriXs4(CStr(Code)))
    Debug.Print ("")
Next

End Sub

Et le résultat

(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012315678
(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012315678
(01) GTIN de l’article: 00843997013703
(11) Date de production: 210601
(3630) Déscription non codée : 123456
(17) Date d'expiration : 230601
(8006) ITIP: 12345678901231, checksum OK | numéro de la pièce dans la série : 56, nombre de pièces dans la série : 78

(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012345678
(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012345678

Attention ça c'est mal passé !

(01) GTIN de l’article: 00843997013703
(11) Date de production: 210601
(3630) Déscription non codée : 123456
(17) Date d'expiration : 230601
(8006) ITIP: erreur checksum, 12345678901234 | numéro de la pièce dans la série : 56, nombre de pièces dans la série : 78

(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012310078
(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012310078

Attention ça c'est mal passé !

(01) GTIN de l’article: 00843997013703
(11) Date de production: 210601
(3630) Déscription non codée : 123456
(17) Date d'expiration : 230601
(8006) ITIP: 12345678901231, checksum OK | Erreur de numérotation, numéro de la pièce dans la série : 0, nombre de pièces dans la série : 78

(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012315600
(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012315600

Attention ça c'est mal passé !

(01) GTIN de l’article: 00843997013703
(11) Date de production: 210601
(3630) Déscription non codée : 123456
(17) Date d'expiration : 230601
(8006) ITIP: 12345678901231, checksum OK | Erreur de numérotation, numéro de la pièce dans la série : 56, nombre de pièces dans la série : 0

(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012317856
(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012317856

Attention ça c'est mal passé !

(01) GTIN de l’article: 00843997013703
(11) Date de production: 210601
(3630) Déscription non codée : 123456
(17) Date d'expiration : 230601
(8006) ITIP: 12345678901231, checksum OK | Erreur de numérotation, numéro de la pièce dans la série : 78, nombre de pièces dans la série : 56

(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012347856
(01)00843997013703(11)210601(3630)123456(17)230601(8006)123456789012347856

Attention ça c'est mal passé !

(01) GTIN de l’article: 00843997013703
(11) Date de production: 210601
(3630) Déscription non codée : 123456
(17) Date d'expiration : 230601
(8006) ITIP: erreur checksum, 12345678901234 | Erreur de numérotation, numéro de la pièce dans la série : 78, nombre de pièces dans la série : 56

NeriXs · Answer

Tous simplement parfait !

Tu as bien fait d'insister sur le Select Case !

Merci

Je devrais pouvoir me débrouiller pour la présentation (Si par présentation, tu fais allusion à l'UserForm!).

Je bute sur truc bête, concernant les 2 messages "checksum" et "numero + totalSerie"  .

Les faire s'afficher sur 2 MsgBox distincts ?

En reprenant l'AI concernée.

MsgBox1 = (8006), checksum OK.

MsgBox2 = (8006), pièce 2 sur 3.

NeriXs · Answer

Je cherche à générer depuis mes codes-barres l'URL GS1 Digital Link URI

Exemple

Avec le code-barres:

"]C1010060791513760121200005429 " + Chr(29) + "111906063001 " + Chr(29) + "101356981"

L'URL doit être crée:

https://id.gs1.org/01/00607915137601/10/1356981/21/200005429?11=190606&30=01

Ce qui donne:
Company Name: Applied Medical Resources Corporation

Le sujet est traité ici:

https://github.com/gs1/gs1-digital-link-uri-simple-parser

Ça semble être du C, que je ne sais pas lire!

D'après cette source et dans mon objectif, ceci est-il facilement réalisable en VBA?

NeriXs · Answer

Peut-être une autre approche!

En jouent avec ce générateur:

https://gs1.github.io/2d-barcode-generator/

J'en conclue qu'on pourrait essayer de coder cette logique:

L'url commence toujours par:
https://id.gs1.org

Suivi d'un slash /

Suivi d'un des 16 AI, appelé "Primary key (AI)" suivant:
00, 01, 253, 255, 401, 402, 414, 415, 417, 7240, 8003, 8004, 8006, 8010, 8017, 8018

Suivi d'un slash /

Suivi de la data correspondent.

Suivi d'un slash /

Suivi d'un des 3 AI, appelé "Key qualifiers (AI)" suivant:
22, 10, 21

Suivi d'un slash /

Suivi de la data correspondent.

Il peut y avoir "0 à 3" Key qualifiers (AI) à la suite, ils sont séparés par un slash /

Suivi d'un point d'interrogation ?, qui marque la fin de Key qualifiers (AI)
Le point d'interrogation ? doit être présent même s'il n'y a pas de Key qualifiers (AI)

Suivi d'un des autres AI restants, appelé "Data attributes (AI)".

Suivi de égale =

Suivi de la data correspondent.

Suivi de l'esperluette & s'il y a plusieurs "Data attributes (AI)" à la suite.
Là aussi "Data attributes (AI)" peut être absent de l'url.
L'ordre des Key qualifiers (AI) et des Data attributes (AI) n'a pas d'importance.

La difficulté est de récupérer les AI + data pour les classer en 3 groupes soit:
Primary key (AI), Key qualifiers (AI) et Data attributes (AI) et reconstituer l'url.

Whismeril · Answer

Je me suis mal exprimé.

Des collections de numéro d'AI, ça ne sert pas à grand-chose.

Ce qu'il faut stocker, c'est les éléments qui serviront à écrire l'url.

Première intention (mais p'tet pas le mieux, j'y reviens après)

Dans cette boucle de

Do
    boucleOut = False
    For Each pattern In patterns
        'on teste chaque pattern pour le début du code
        regex.pattern = "^" + pattern
        If (regex.test(Code)) Then
            boucleOut = True
            ligne1 = ""
            'si ça marche, on extrait la partie
            Set Match = regex.Execute(Code)(0)
    
            Set unCode = New unCode
            unCode.Init Match.SubMatches(0), Match.SubMatches(1)
            resultats.Add unCode
            
            'on enlève ce qu'on vient de traiter
            Code = Replace(Code, Match.Value, "")
            
            'et on recommence
            Exit For
        End If
    Next
Loop While Len(Code) > 0 And boucleOut

En plus de mettre unCode dans la collection resultats, on pourrait tester l'AI avec un select case et le stocker aussi dans une des collections qui serviront ensuite à construire l'url.

Mais ça fait un second select case.

L'autre option est d'ajouter des attributs dans la classe unCode, IsPrimaryKeys, IsKeyQualifier et IsDataAttribute, que tu remplis dans le Select Case existant.

Et à la fin quand on écrit ligne 1 et ligne 2, on teste ces attributs et on écrit le cas échéant les 3 morceaux d'url.

PS, je débute aujourd'hui, une mission à 500km de chez moi jusqu'à mi mars.

J'aurais moins de temps en semaine et surtout les week-ends, je vais les consacrer à ma famille.

Je vais continuer à essayer de te donner des pistes, mais des codes entiers, ça sera plus difficile.

NeriXs · Answer

Bonjours,

Citation:

PS, je débute aujourd'hui, une mission à 500km de chez moi jusqu'à mi-mars.
J'aurais moins de temps en semaine et surtout les week-ends, je vais les consacrer à ma famille.
Je vais continuer à essayer de te donner des pistes, mais des codes entiers, ça sera plus difficile.

Je te souhaite réussite et satisfaction pour cette nouvelle mission!

Sans toi, ce projet n'en serait pas ou il en est!
Je serais patient avec mes difficultés.

Pour commencer j'ai fait un petit mémo des situations:

PrimaryKey seul:
(01)00607915137601
https://id.gs1.org/01/00607915137601

PrimaryKey + 1 KeyQualifier (sans IsDataAttribute):
(01)00607915137601(21)BBBBBBB
https://id.gs1.org/01/00607915137601/21/BBBBBBB

PrimaryKey (sans KeyQualifier) + 1 DataAttribute:
(01)00607915137601(17)230612
https://id.gs1.org/01/00607915137601?17=230612

PrimaryKey + 2 KeyQualifiers + 2 DataAttributes:
(01)00607915137601(11)230410(15)230511(17)230612(10)AAAAAA(21)BBBBBBB
https://id.gs1.org/01/00607915137601/10/AAAAAA/21/BBBBBBB?11=230410&15=230511&17=230612

Ensuite, au niveau de la classe unCode:

'Méthode qui retourne un texte sous la forme "https://id.gs1.org/Balise/LeCode"
Public Function IsPrimaryKey() As String
    IsPrimaryKey = "https://id.gs1.org/" & AI & "/" & Code
End Function

'Méthode qui retourne un texte sous la forme "/Balise/LeCode"
Public Function IsKeyQualifier() As String
    IsKeyQualifier = "/" & AI & "/" & Code
End Function

'Méthode qui retourne un texte sous la forme "Balise=LeCode"
Public Function IsDataAttribute() As String
    IsDataAttribute = AI & "=" & Code
End Function

La suite se complique.

Au niveau du Select Case comment exploiter?

Au niveau du module, création d'une ligne3 et ensuite l'appel aux case concernées?

Je suis un peu dans le flou.

Il y a aussi la gestion du point d'interrogation pour la fin de KeyQualifier, qu'il y en ai ou pas.
Et le séparateur de DataAttribute "&".

Whismeril · Answer

En général (et donc ça coulait de source pour moi), un attribut IsQuelqueChose est un boulean. Par exemple IsNumeric retourne si c'est un nombre ou pas.

Dans le select case de la classe, quand l'AI correspond à une PrimaryKey, tu mets True à IsPrimary et pareil pour les 2 autres.

Et là

'Dim primaryKey, ...., url as String

ValidationData = True 'par défaut on considère que tout est correct
For i = 1 To resultats.Count
    Set unCode = resultats(i)
    ligne1 = ligne1 + unCode.Texte
    ligne2 = ligne2 + vbCrLf + unCode.Description
    If unCode.ValidationData = False Then 's'il y a au moins une data incorrecte ça sera signalé
        ValidationData = False
    End If
    If unCode.IsPrimaryKey Then
        primaryKey = primaryKey + 'construction de la partie d'url qui correspond à cet AI
    End If
    'Idem pour les 2 autres
Next
If ValidationData = False Then
    ligne2 = vbCrLf + vbCrLf + "Attention ça c'est mal passé !" + vbCrLf + ligne2
End If

url = primaryKey + ... + ...

NeriXs · Answer

Bonsoir, J'y suis presque! Je ne sais pas comment gérer le point d'interrogation ?, qui marque la fin de keyQualifier. Point d'interrogation, qui doit être présent quand il n'y a pas de keyQualifier mais, qu'il y a des dataAttribute (Point d'interrogation avant les dataAttribute). Point d'interrogation est absent s'il n'y a pas de pas de dataAttribute après keyQualifier. Les ajouts de la classe unCode: Public IsPrimaryKey As Boolean Public IsKeyQualifier As Boolean Public IsDataAttribute As Boolean Au niveau du Select Case (un exemple avec 3 AI, un de chaque groupe qui compose l'URL): Case "01" madescription = "(01) N° ARTICLE (GTIN): " IsPrimaryKey = True Case "21" madescription = "(21) N° SÉRIE: " IsKeyQualifier = True Case "240" madescription = "(240) ID ADDITIONNEL: " IsDataAttribute = True Le code du module: Dim primaryKey, keyQualifier, dataAttribute, url As String ValidationData = True 'par défaut on considère que tout est correct For i = 1 To resultats.Count Set unCode = resultats(i) ligne1 = ligne1 + unCode.Texte ligne2 = ligne2 + unCode.Description + vbCrLf If unCode.ValidationData = False Then 's'il y a au moins une data incorrecte ça sera signalé ValidationData = False End If If unCode.IsPrimaryKey Then primaryKey = primaryKey + unCode.AI + "/" + unCode.Code 'construction de la partie d'url qui correspond à cet AI End If If unCode.IsKeyQualifier Then keyQualifier = keyQualifier + "/" + unCode.AI + "/" + unCode.Code 'construction de la partie d'url qui correspond à cet AI End If If unCode.IsDataAttribute Then dataAttribute = dataAttribute + "&" + unCode.AI + "=" + unCode.Code 'construction de la partie d'url qui correspond à cet AI End If Next If ValidationData = False Then ligne2 = vbCrLf + vbCrLf + "ATTENTION, vérifier les données de contrôle !" + vbCrLf + vbCrLf + ligne2 End If url = "https://id.gs1.org/" + primaryKey + keyQualifier + dataAttribute '+ ... + ... UserForm1.TextBox_Code_HRI = ligne1 UserForm1.TextBox_All_Data = ligne2 UserForm1.TextBox_Digital_Link_URI = url Ci-dessous le résultat de plusieurs tests En 1er ligne le code scanné En 2eme ligne le code lisible par l'homme (HRI) En 3eme ligne, l'url que j'obtiens En 4eme ligne ce que donne le décodeur GS1 J'ai volontairement mis en évidence les balises de séparation " \x1d" en les remplaçants par . PrimaryKey seul: ]d20109420012407221 (01)09420012407221 https://id.gs1.org/01/09420012407221 https://id.gs1.org/01/09420012407221 PrimaryKey + dataAttribute: ]C101008838738677921122092717230927 (01)00883873867792(11)220927(17)230927 https://id.gs1.org/01/00883873867792&11=220927&17=230927 https://id.gs1.org/01/00883873867792?11=220927&17=230927 PrimaryKey + keyQualifier: ]C101008838738677921022092721PC23713163 (01)00883873867792(10)220927(21)PC23713163 https://id.gs1.org/01/00883873867792/10/220927/21/PC23713163 https://id.gs1.org/01/00883873867792/10/220927/21/PC23713163 PrimaryKey + keyQualifier + dataAttribute: ]C1010088387386779211220927172309271022092721PC23713163 (01)00883873867792(11)220707(17)230707(10)220707(21)PC22412085 https://id.gs1.org/01/00883873867792/10/220707/21/PC22412085&11=220707&17=230707 https://id.gs1.org/01/00883873867792/10/220707/21/PC22412085?11=220707&17=230707

Whismeril · Answer

Bonsoir

en #154 tu as écrit

Suivi d'un point d'interrogation ?, qui marque la fin de Key qualifiers (AI)

Le point d'interrogation ? doit être présent même s'il n'y a pas de Key qualifiers (AI)

....

Suivi de l'esperluette & s'il y a plusieurs "Data attributes (AI)" à la suite.

Donc c'est après les KeyQualifier qu'il faut le mettre.

Par contre, il ne faut pas mettre de & au tout début de la construction des dataAttribute, mais à partir du second

Pas testé

For i = 1 To resultats.Count
    Set unCode = resultats(i)
    ligne1 = ligne1 + unCode.Texte
    ligne2 = ligne2 + unCode.Description + vbCrLf
    If unCode.ValidationData = False Then 's'il y a au moins une data incorrecte ça sera signalé
        ValidationData = False
    End If
    If unCode.IsPrimaryKey Then
        primaryKey = primaryKey + unCode.AI + "/" + unCode.Code 'construction de la partie d'url qui correspond à cet AI
    End If
    If unCode.IsKeyQualifier Then
        keyQualifier = keyQualifier + "/" + unCode.AI + "/" + unCode.Code 'construction de la partie d'url qui correspond à cet AI
    End If
    If unCode.IsDataAttribute Then
        If dataAttribute <> "" Then
            dataAttribute = dataAttribute + "&" 'si y'a déjà un data attribute
        End If
        dataAttribute = dataAttribute + unCode.AI + "=" + unCode.Code 'construction de la partie d'url qui correspond à cet AI
    End If
Next
If ValidationData = False Then
    ligne2 = vbCrLf + vbCrLf + "ATTENTION, vérifier les données de contrôle !" + vbCrLf + vbCrLf + ligne2
End If

Url = "https://id.gs1.org/" + primaryKey + keyQualifier + "?" + dataAttribute

NeriXs · Answer

Bonsoir,

Dans mon poste précédent, j'apporte plus d'informations.

Citation:

Le point d'interrogation ?, qui marque la fin de keyQualifier.
Point d'interrogation, qui doit être présent quand il n'y a pas de keyQualifier mais, qu'il y a des dataAttribute (Point d'interrogation avant les dataAttribute).
Point d'interrogation est absent s'il n'y a pas de pas de dataAttribute après keyQualifier.

Je peux ajouter que ce point d'interrogation est absent si primaryKey est seul.

Cas où c'est bon:

]C101008838738677921122092717230927
(01)00883873867792(11)220927(17)230927
https://id.gs1.org/01/00883873867792?11=220927&17=230927

]C1010088387386779211220927172309271022092721PC23713163
(01)00883873867792(11)220707(17)230707(10)220707(21)PC22412085
https://id.gs1.org/01/00883873867792/10/220927/21/PC23713163?11=220927&17=230927

Cas où ce n'est pas bon:

]d20109420012407221
(01)09420012407221
https://id.gs1.org/01/09420012407221 ?

]C101008838738677921022092721PC23713163
(01)00883873867792(10)220927(21)PC23713163
https://id.gs1.org/01/00883873867792/10/220927/21/PC23713163 ?

Le 1er cas où ce n'est pas bon c'est primaryKey est seul.

Le 2eme c'est keyQualifier sans dataAttribute.

Ça complique les choses!

J'essaie de supprimer le point d'interrogation de l'url avant affichage s'il est à la fin, mais je ne trouve pas la bonne méthode.

Whismeril · Answer

Heu... là, t'as copié collé mon dernier code sans le regarder ?

OK, j'avais raté l'info qu'il ne devait pas y avoir de ? si pas de dataAttribute, mais c'est exactement pareil que le &.

Y'a un cas où il le faut et un ou il ne le faut pas.

NeriXs · Answer

Je l'avais bien vu!

If unCode.IsDataAttribute Then
        If dataAttribute <> "" Then
            dataAttribute = dataAttribute + "&" 'si y'a déjà un data attribute
        End If
        dataAttribute = dataAttribute + unCode.AI + "=" + unCode.Code 'construction de la partie d'url qui correspond à cet AI
    End If

Je n'ai pas réussi à l'adapter, car comme évoqué précédemment, il y a 2 cas de figure ou le point d'interrogation doit être absent:

1)    Si primaryKey seul.

(01)09420012407221
       https://id.gs1.org/01/09420012407221"?"

2)    Si pas de dataAttribute

(01)00883873867792(10)220927(21)PC23713163
       https://id.gs1.org/01/00883873867792/10/220927/21/PC23713163"?"

Comme c'est OK dans tous les autres cas et que le point d'interrogation est ajouté à la construction de l'url, j'ai pensé que ce serait plus simple de le supprimer, car il est toujours en fin d'url quand c'est l'un de ces 2 cas.

Whismeril · Answer

Url = "https://id.gs1.org/" + primaryKey + keyQualifier
If dataAttribute <> "" Then
    Url = Url + "?" + dataAttribute
End If

NeriXs · Answer

Bonsoir,

Je ne pensais pas que la gestion des dates serait aussi complexe!

Comme pour le CheckSum, j'ai regardé comment traiter la validité des dates contenue dans certains AI.

1er problème, le format des dates "US" sur 6 chiffres soit : YYMMDD

Le test suivant me confirme que je ne suis pas dans le bon format:

Sub test()
Dim textDate As String
textDate = "140585"
''textDate = "231123"
textDate = Format(textDate, "00\/00\/00")
Dim realDate As Date
realDate = DateValue(textDate)
Debug.Print realDate  '<~ returns 14/05/1985
End Sub

Résultat respectif:

14/05/1985
23/11/2023

Soit: DDMMYY

Apparemment il serait possible de remédier à ce problème via les paramètres régionaux:

https://stackoverflow.com/questions/51620085/change-region-format-to-another-language-with-vba

Là j'avoue être complétement dépassé par le code ci-dessus.

La documentation "gs1-syntax-dictionary" donne 3 codes en C que je ne sais pas lire!

Ils peuvent peut-être aider?

-yymmd0
https://gs1.github.io/gs1-syntax-dictionary/lint__yymmd0_8c.html

-yymmdd
https://gs1.github.io/gs1-syntax-dictionary/lint__yymmdd_8c.html

-yymmddhh
https://gs1.github.io/gs1-syntax-dictionary/lint__yymmddhh_8c.html

J'ai fait un petit récapitulatif des AIs qui utilisent ces codes et de la position du traitement:

N6,yymmdd
AI: 4326, 7006
-
N6,yymmdd N4,hhmm
AI: 7003
-
N6,yymmdd [N6],yymmdd
AI: 7007
-
N6,yymmdd [N4],hhmm
AI: 7001
-
N8,yymmddhh [N..4]
AI: 8008
-
N6,yymmd0
AI: 11, 12, 13, 15, 16, 17
-
N6,yymmd0 N4,hhmm
AI: 4324, 4325
-

Une idée de comment gérer ces dates en VBA?

Whismeril · Answer

Bonjour

alors oui les dates c'est un sérieux problème, et encore 140585, c'est facile, si on admet qu'il n'y a que des yymmdd ou des ddmmyy

Il suffit de découper en 3 groupes de 2 chiffres, celui du milieu c'est toujours le mois, ensuite on  constate que 85 est supérieur à 31 donc forcément c'est l'année, celui qui reste le jour.

Évidemment si on commence à supposer qu'on peut aussi avoir yyddmm ou mmddyy, 140585 n'est plus interprétable.

Et que dire de 100811 ?

Tu peux y appliquer tous les algorithmes que tu veux, tous les formats sont possibles impossible sans autre information de choisir le bon.

NeriXs · Answer

Selon la documentation GS1, les dates sont toujours au format YYMMDD (Année sur 2 chiffres en 1er, suivit du moi sur 2 chiffres, puis jour sur 2 chiffres). Si cette règle n'est pas respectée, pas de contrôle de date valide, juste un avertissement de non-conformité avec GS1. En gérant à partir de 2000 vu que ces dates sont des dates de production, de garantie, de péremption, de livraison …) et en considèrent que la durée de vie moyenne d'un article est de 15 ans, on devrait être dans les clous. Dans cette logique, 100811 donne 2010/08/11 Je ne parviens pas à coder quelque chose qui donne ce résultat! Je suis bloqué sur la résolution: YYMMDD = YYYYMMDD La suite pourrait être géré de cette façon: Option Explicit Function validExcelDate(num As Long) As Boolean Dim Y As Long, M As Long, D As Long Dim leapYr As Boolean Dim dt1904 As Boolean dt1904 = ThisWorkbook.Date1904 'Would also be valid year if test passed If num < IIf(dt1904, 19040101, 19000101) _ Or num > 99991231 Then Exit Function 'special case If num = 19000229 Then validExcelDate = True Exit Function End If D = num Mod 100 M = Int((num Mod 10000) / 100) Y = Int(num / 10000) 'valid month If M < 1 Or M > 12 Then Exit Function 'valid day If D < 1 Then Exit Function leapYr = LY(Y) Select Case M Case 4, 6, 9, 11 If D > 30 Then Exit Function Case 2 If D > 29 Then Exit Function If leapYr = False And D > 28 Then Exit Function Case Else If D > 31 Then Exit Function End Select validExcelDate = True End Function Private Function LY(yr As Long) As Boolean If yr / 4 = Int(yr / 4) And _ Not (yr / 100 = Int(yr / 100)) Then _ LY = True If yr / 400 = Int(yr / 400) Then LY = True End Function Résultat OK pour 20231129 L'ajout des slashs peut être faite après! Le problème est " ThisWorkbook.Date1904" applicable à une feuille. Je n'ai pas trouvé d'équivalant pour une variable!

Whismeril · Answer

Bonsoir

Selon la documentation GS1, les dates sont toujours au format YYMMDD

Je suis bloqué sur la résolution:
YYMMDD = YYYYMMDD

C'est contradictoire, si le format est censé toujours être YYMMDD, alors t'as pas à gérer le cas YYYYMMDD

Je ne comprends pas à quoi servent tes lignes 5 à 18, mais si tu les enlèves, ça a l'air de fonctionner (sur 3 dates valides).

Ensuite, pour la fonction LY ce serait bien plus simple avec des mod.

If yr m 4 = 0 and '...

NeriXs · Answer

Bonsoir L'année sur 4 chiffres me facilite les tests! Et pour l'affichage du contrôle final "résultat codé dans les Select case" j'ai l'intention de les afficher sous le format jj/mm/aaaa à la française ;) Je suis repartie de zéro et j'avance doucement! J'ai essayé de reproduire ce que je pense avoir compris de la lecture du code C suivant: -yymmd0 https://gs1.github.io/gs1-syntax-dictionary/lint__yymmd0_8c.html A l'exception de: if (YY - CURRENT_YEAR >= 51) yyyy = 1900 + YY; else if (YY - CURRENT_YEAR > -50) yyyy = 2000 + YY; else yyyy = 2100 + YY; Que je ne comprends pas, je suis donc partie sur les années 2000 à 2099! Je n'ai pas réussi à coder le tout en une étape. Donc en 1er, je convertie la date du format YYMMDD vers le format DDMMYYYY. Private Sub convertDate() Dim sTmp As String Dim sDate, sDateNoSlashs As Variant sTmp = "290421" If Not IsNumeric(sTmp) Then Debug.Print "Date doit être être composée de chiffres" Exit Sub End If If Len(sTmp) < 6 Then Debug.Print "Date trop courte!" Exit Sub End If If Len(sTmp) > 6 Then Debug.Print "Date trop longue!" Exit Sub End If sDate = Right(sTmp, 2) & "/" & Mid(sTmp, 3, 2) & "/20" & Left(sTmp, 2) If Not IsDate(sDate) Then Debug.Print "Date non conforme!" Else sDateNoSlashs = Replace(sDate, "/", "") Debug.Print sTmp & " = " & sDateNoSlashs Debug.Print "yymmdd = ddmmyyyy" End If End Sub Résultat: 290421 = 21042029 yymmdd = ddmmyyyy En 2 éme, contrôle sur les jours, les jours du moi, les mois, les années et prise en charge des années bissextiles. Puis conversion du format DDMMYYYY vers le format DD/MM/YYYY pour affichage plus lisible. Sub CheckDate() Dim strDate As String, dtDate As Date Dim yy As Integer, mm As Integer, dd As Integer strDate = "21042029" 'Range("A1").Text yy = CInt(Right(strDate, 4)) mm = CInt(Mid(strDate, 3, 2)) dd = CInt(Left(strDate, 2)) If yy = 0 Or yy < 2000 Or yy > 2099 Then Debug.Print "year is bad" Exit Sub End If If dd < 1 Then Debug.Print "day is bad" Exit Sub End If If (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) And dd > 31 Then Debug.Print "Ce moi n'a que 31 jours!" Exit Sub End If If (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) And dd > 30 Then Debug.Print "Ce moi n'a que 30 jours!" Exit Sub End If If yy Mod 4 = 0 And yy Mod 100 = 0 And yy Mod 400 = 0 Then If mm = 2 And dd > 29 Then Debug.Print "Ce moi n'a que 29 jours!" Exit Sub End If Else If mm = 2 And dd > 28 Then Debug.Print "Ce moi n'a que 28 jours!" Exit Sub End If End If dtDate = DateSerial(yy, mm, dd) Debug.Print strDate & " = " & dtDate End Sub Résultat: 21042029 = 21/04/2029 Je pense être sur la bonne voie ?

Whismeril · Answer

Bonjour Sub TestDate() CheckDate ("231201") CheckDate ("000229") CheckDate ("010229") Debug.Print (EstBissextile(2100)) End Sub Function CheckDate(strDate As String) As Date 'on suppose qu'à cette étape, par la régex d'avant tu as déjà validé que c'est 6 chiffres Dim dtDate As Date Dim yy As Integer, mm As Integer, dd As Integer yy = CInt(Left(strDate, 2)) + 2000 'Je cite : En gérant à partir de 2000 vu que ces dates sont des dates de production, de garantie, de péremption, de livraison …) et en considèrent que la durée de vie moyenne d'un article est de 15 ans, on devrait être dans les clous. Dans cette logique, 100811 donne 2010/08/11 mm = CInt(Mid(strDate, 3, 2)) dd = CInt(Right(strDate, 2)) If dd = 0 Or dd > 31 Then Debug.Print "day is bad" Exit Function End If If (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) And dd > 30 Then Debug.Print "Ce moi n'a que 30 jours!" Exit Function End If If EstBissextile(yy) Then 'ton test n'était pas tout à fait juste, mais dans l'absolue, entre 2000 et 2099, la divisibilté par 4 est le seul critère utilisé If mm = 2 And dd > 29 Then Debug.Print "Ce moi n'a que 29 jours!" Exit Function End If Else If mm = 2 And dd > 28 Then Debug.Print "Ce moi n'a que 28 jours!" Exit Function End If End If dtDate = DateSerial(yy, mm, dd) Debug.Print strDate & " = " & dtDate CheckDate = dtDate End Function Function EstBissextile(Annee As Integer) As Boolean 'une année bissextile est divisible par 4 If Annee Mod 4 <> 0 Then EstBissextile = False Exit Function End If 'une année bissextile est divisible par 400 et par 100 en même temps, mais pas par 100 seul If Annee Mod 100 = 0 And Annee Mod 400 <> 0 Then EstBissextile = False Exit Function End If EstBissextile = True End Function

NeriXs · Answer

Bonjour,

Merci pour cette adaptation /correction.

Dans un but purement éducatif, je travaille sur une version de ton code qui se rapprocherait au maximum du code C.

Concernant cette partie du code C:

if (YY - CURRENT_YEAR >= 51)
                 yyyy = 1900 + YY;
         else if (YY - CURRENT_YEAR > -50)
                 yyyy = 2000 + YY;
         else
                 yyyy = 2100 + YY;

Je ne comprends pas dans quelle condition "yyyy = 2100 + yy" peut être validée?

J'ai testé de cette façon:

Sub test()
YY = 48
current_year = Right(Year(Now), 2) + 0

If (YY - current_year >= 51) Then
        YYYY = 1900 + YY
    ElseIf (YY - current_year > -50) Then
        YYYY = 2000 + YY
    Else
        YYYY = 2100 + YY
    End If
End Sub

Même en modifiant la date de current_year comme ceci:

current_year = Right(Year(2199), 2) + 0

La condition YYYY = 2100 + YY ne semble jamais être vérifiée?
Pourrais-tu me donner plus d'explication?

NeriXs · Answer

Et concrètement, comment modifierais-tu ceci en considèrent ce qu'on connaît ?

Sub test()
YY = 48
current_year = Right(Year(Now), 2) + 0

If (YY - current_year >= 51) Then
        YYYY = 1900 + YY
    ElseIf (YY - current_year > -50) Then
        YYYY = 2000 + YY
    Else
        YYYY = 2100 + YY
    End If
End Sub

Tous simplement :

Sub test()
YY = 48
current_year = Right(Year(Now), 2) + 0

If (YY - current_year >= 51) Then
        YYYY = 1900 + YY
    ElseIf (YY - current_year > -50) Then
        YYYY = 2000 + YY
    End If
End Sub

??

Whismeril · Answer

ha oui, comme je l'ai dit, c'était tapé de tête sans vérification

Whismeril · Answer

Premiers tests

Sub TestYear()
Debug.Print ("Année 2023 en pivot")
Debug.Print ("23 => " & SetYear(23, Year(Now)))
Debug.Print ("72 => " & SetYear(72, Year(Now)))
Debug.Print ("73 => " & SetYear(73, Year(Now)))
Debug.Print ("74 => " & SetYear(74, Year(Now)))
Debug.Print ("75 => " & SetYear(75, Year(Now)))
Debug.Print ("")
Debug.Print ("Année 2123 en pivot")
Debug.Print ("23 => " & SetYear(23, 2123))
Debug.Print ("72 => " & SetYear(72, 2123))
Debug.Print ("73 => " & SetYear(73, 2123))
Debug.Print ("74 => " & SetYear(74, 2123))
Debug.Print ("75 => " & SetYear(75, 2123))
End Sub

Function SetYear(YY As Integer, pivot As Integer) As Integer
    Dim current_year, siecle As Integer
    
    current_year = pivot Mod 100
    siecle = pivot - current_year
    
    If current_year < 50 Then 'ou p'tet 49 ou 51 selon les piquets et les barrières
       siecle = siecle - 100
    End If

If (YY - current_year >= 51) Then
        SetYear = siecle + YY
    ElseIf (YY - current_year > -50) Then
        SetYear = siecle + 100 + YY
    End If
End Function

Résultats

Année 2023 en pivot
23 => 2023
72 => 2072
73 => 2073
74 => 1974
75 => 1975

Année 2123 en pivot
23 => 2123
72 => 2172
73 => 2173
74 => 2074
75 => 2075

A première vue, ça correspond à ce que j'ai compris de ton envie/besoin

NeriXs · Answer

Je suis repartie de 0 en oubliant le modèle du code C.

En cherchant ce qui pourrai nous être utile pour ce problème de siècle, j'ai repensé à la formule que j'avais utilisé pour récupérer les 2 caractères de droite de Year(Now) "message 184".

current_year = Right(Year(Now), 2) + 0

Et pourquoi pas utiliser les 2 caractères de gauche pour identifier le siècle ?

Option Explicit

Sub Test()
Dim current_year As Date
Dim YYYY, YY As String

YY = 74

'current_year = Left(Year(Now), 2) + 0
current_year = Left("1923", 2) + 0

If current_year = 19 Then
        YYYY = 1900 + YY
        Debug.Print YYYY
    ElseIf current_year = 20 Then
        YYYY = 2000 + YY
        Debug.Print YYYY
    ElseIf current_year = 21 Then
        YYYY = 2100 + YY
        Debug.Print YYYY
    End If
End Sub

Les tests semblent concluants.

NeriXs · Answer

Bonsoir, Je croix que cette fois c'est bon! L'idée appliquée: (Si année en cours – 50 est négatif et YY inférieur ou = à 50) = siècle en cours, si non siècle d'avant. (Si année en cours - 50 est positif et YY Supérieur ou = à 50) = siècle en cours, si non siècle d'après. 'Pour 2023 'Les valeurs YY comprises entre 50 et 99 indiquent les années 1950 à 1999. 'Les valeurs YY comprises entre 00 et 49 indiquent les années 2000 à 2049. 'A partir de 2050 'Les valeurs YY comprises entre 50 et 99 indiquent les années 2050 à 2099. 'Les valeurs YY comprises entre 00 et 49 indiquent les années 2100 à 2149. Function SetYear(YY As Integer, pivot As Integer) As Integer Dim current_year As Integer, siecle As Integer current_year = Right((pivot), 2) + 0 siecle = (pivot) - current_year If current_year - 50 <= 0 Then If YY < 50 Then SetYear = siecle + YY Else SetYear = siecle - 100 + YY End If ElseIf current_year - 50 >= 0 Then If YY < 50 Then SetYear = siecle + 100 + YY Else SetYear = siecle + YY End If End If End Function Sub TestYear() Debug.Print ("Année 2023 en pivot") Debug.Print ("23 => " & SetYear(23, Year(Now))) Debug.Print ("49 => " & SetYear(49, Year(Now))) Debug.Print ("50 => " & SetYear(50, Year(Now))) Debug.Print ("99 => " & SetYear(99, Year(Now))) Debug.Print ("") Debug.Print ("Année 2050 en pivot") Debug.Print ("23 => " & SetYear(23, 2050)) Debug.Print ("49 => " & SetYear(49, 2050)) Debug.Print ("50 => " & SetYear(50, 2050)) Debug.Print ("99 => " & SetYear(99, 2050)) Debug.Print ("") Debug.Print ("Année 2051 en pivot") Debug.Print ("23 => " & SetYear(23, 2051)) Debug.Print ("49 => " & SetYear(49, 2051)) Debug.Print ("50 => " & SetYear(50, 2051)) Debug.Print ("99 => " & SetYear(99, 2051)) Debug.Print ("") Debug.Print ("Année 2099 en pivot") Debug.Print ("23 => " & SetYear(23, 2099)) Debug.Print ("49 => " & SetYear(49, 2099)) Debug.Print ("50 => " & SetYear(50, 2099)) Debug.Print ("99 => " & SetYear(99, 2099)) End Sub

NeriXs · Answer

Bonsoir,

Au final c'est bien ton dernier code, le bon!

J'ai imaginé des scénarios qui ne respectaient pas les critères de départ soit:
La chaîne "YY" ne peut spécifier qu'une date comprise entre 49 ans dans le passé et 50 ans dans le futur avec comme pivot, l'année en cours.

J'ai été un peu perturbé par la façon dont tu as initié tes tests :

For i = Year(Now) To Year(Now) + 100 Step 10
    Debug.Print ("Année " & i & " en pivot")
    a = i Mod 100
    a = (i + 49) Mod 100
    Debug.Print (a & " => " & SetYear(a, i + 0))
Next

J'ai adapter le test pour que je puisse plus facilement valider les résultats:

Sub TestYear()
    Dim i As Integer
    Dim myDate As Integer

myDate = "2099" '2023, 2049, 2050, 2051, 2075, 2099

Debug.Print ("Année " & myDate & " en pivot")

For i = 0 To 99
        Debug.Print (Format(i, "00") & "  => " & SetYear(i, myDate))
    Next
End Sub

Je passe comme prévu ce poste en résolut!

Merci pour tout le travail effectué et surtout le temps consacré aux explications et démonstrations.

NeriXs · Answer

Bonjour,

Je reviens sur la création des url.
Url = "https://id.gs1.org/" + primaryKey + keyQualifier + dataAttribute

J'ai des url qui ne sont pas valide!
La cause, un ordre à respecter pour certain keyQualifie!
Ces keyQualifie sont 22, 10 et 21.
Si présents, ils doivent être placé dans un ordre précis, soit:
 AI = 22, si présent toujours en 1er position, suivie de l'AI = 10 si présent, suivi de l'AI=21 si présent.
L'ordre des autres keyQualifier n'a pas d'importance.

Actuellement avec cet exemple de code-barres:
"]C101008838738677921723070710220707" + Chr(29) + "22AvBn220707" + Chr(29) + "21PC22412085"

J'obtiens l"URL:
https://id.gs1.org/01/00883873867792/10/220707/22/AvBn220707/21/PC22412085?17=230707
Cette url n'est pas valide.

L'url valide est :
https://id.gs1.org/01/00883873867792/22/AvBn220707/10/220707/21/PC22412085?17=230707

Comment pourrais-je gérer cet ordre a la création de l'url?

NeriXs · Answer

Module: Option Explicit Function GS1_Resolver(Code As String) As String Dim fnc1, gs, caracteresOK, pattern, LigneHRI, LigneDecodeData, LigneControlData As String Dim regex, Match As Object Dim i As Integer Dim resultats As Collection Dim unCode As unCode Dim boucleOut As Boolean Dim patterns As New Collection Set regex = New RegExp 'écriture des patterns unitaires gs = "(\x1d|$)?" 'quand c'est peut-être fnc1 = "(\x1d|$|\()" 'quand c'est obligé caracteresOK = "[\x21\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]" 'Groupe 1 'Balise: 00 'Pattern GS1: ^0(\d{18})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?\(?(00)$?(\d{18})" + gs 'Groupe [2] 'Balise: 01, 02 'Pattern GS1: ^X(\d{14})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(01|02)$?(\d{14})" + gs 'Groupe [3] 'Balise: 10, 21, 22, 243, 254, 420, 710, 711, 712, 713, 714, 715, 4318, 7020, 7021, 7022, 7240, 8002, 8012 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,20})$ patterns.Add "$?(10|2[12]|243|254|520|71[0-5]|4318|702[0-2]|7240|8002|8012)$?(" + caracteresOK + "{0,20})" + fnc1 'Groupe [4] 'Balise: 20 'Pattern GS1: ^20(\d{2})$ patterns.Add "$?(20)$?(\d{2})" + gs 'Groupe [5] 'Balise: 235 'Pattern GS1: ^235([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,28})$ patterns.Add "$?(235)$?(" + caracteresOK + "{0,28})" + fnc1 'Groupe [6] 'Balise: 90, 240, 241, 250, 251, 400, 401, 403, 4308, 4319, 7002, 7023, 8004 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,30})$ patterns.Add "$?(90|24[0-1]|25[0-1]|40[013]|4308|7319|7002|7023|8004)$?(" + caracteresOK + "{0,30})" + fnc1 'Groupe [7] 'Balise: 242 'Pattern GS1: ^242(\d{0,6})$ patterns.Add "$?(242)$?(\d{0,6})" + fnc1 'Groupe [8] 'Balise: 253 'Pattern GS1: ^253(\d{13})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,17})$ patterns.Add "$?(253)$?(\d{13}" + caracteresOK + "{0,17})" + fnc1 'Groupe [9] 'Balise: 255 'Pattern GS1: ^255(\d{13})(\d{0,12})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(255)$?(\d{13}\d{0,12})" + fnc1 'Groupe [10] 'Balise: 30, 37 'Pattern GS1: ^X(\d{0,8})$ patterns.Add "$?(3[07])$?(\d{0,8})" + fnc1 'Groupe [11] 'Balise: 11, 12, 13, 15, 16, 17 ' 3100 à 3105, 3110 à 3115, 3120 à 3125, 3130 à 3135, 3140 à 3145, 3150 à 3155, 3160 à 3165, ' 3300 à 3305, 3310 à 3315, 3320 à 3325, 3330 à 3335, 3340 à 3345, 3350 à 3355, 3360 à 3365, 3370 à 3375, ' 3500 à 3505, 3510 à 3515, 3520 à 3525, 3530 à 3535, 3540 à 3545, 3550 à 3555, 3560 à 3565, 3570 à 3575, ' 3200 à 3205, 3210 à 3215, 3220 à 3225, 3230 à 3235, 3240 à 3245, 3250 à 3255, 3260 à 3265, 3270 à 3275, 3280 à 3285, 3290 à 3295, ' 3400 à 3405, 3410 à 3415, 3420 à 3425, 3430 à 3435, 3440 à 3445, 3450 à 3455, 3460 à 3465, 3470 à 3475, 3480 à 3485, 3490 à 3495, ' 3600 à 3605, 3610 à 3615, 3620 à 3625, 3630 à 3635, 3640 à 3645, 3650 à 3655, 3660 à 3665, 3670 à 3675, 3680 à 3685, 3690 à 3695, 'Pattern GS1:^11(\d{6})$ patterns.Add "$?(1[123567]|31[0-6][0-5]|3[35][0-7][0-5]|3[246]\d[0-5])$?(\d{6})" + gs 'Groupe [12] 'Balise: 7007 'Pattern GS1: ^7007(\d{6,12})$ patterns.Add "$?(7007)$?(\d{6,12})" + fnc1 'Groupe [13] 'Balise: 7011 'Pattern GS1: ^7011(\d{6})(\d{0,4})$ patterns.Add "$?(7011)$?(\d{6}\d{0,4})" + fnc1 'Groupe [14] 'Balise: 3900 à 3909, 3920 à 3929 'Pattern GS1: ^X(\d{0,15})$ patterns.Add "$?(390[0-9]|392[0-9])$?(\d{0,15})" + fnc1 'Groupe [15] 'Balise: 3910 à 3919, 3930 à 3939 'Pattern GS1: ^X(\d{3})(\d{0,15})$ patterns.Add "$?(391[0-9]|393[0-9])$?(\d{3}\d{0,15})" + fnc1 'Groupe [16] 'Balise: 3940 à 3943, 8111 'Pattern GS1: ^X(\d{4})$ patterns.Add "$?(394[0-3]|8111)$?(\d{4})" + fnc1 'Groupe [17] 'Balise: 3950 à 3959 'Pattern GS1: ^X(\d{0,6})$ patterns.Add "$?(395[0-9])$?(\d{0,6})" + fnc1 'Groupe [18] 'Balise: 402 'Pattern GS1: ^402(\d{17})$ patterns.Add "$?(402)$?(\d{17})" + fnc1 'Groupe [19] 'Balise: 421 'Pattern GS1:^421(\d{3})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,9})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(421)$?(\d{3}" + caracteresOK + "{0,9})" + fnc1 'Groupe [20] 'Balise: 422, 424, 426 'Pattern GS1: ^X(\d{3})$ patterns.Add "$?(42[246])$?(\d{3})" + fnc1 'Groupe [21] 'Balise: 423, 425 'Pattern GS1: ^X(\d{3})(\d{0,12})$ patterns.Add "$?(423|425)$?(\d{3}\d{0,12})" + fnc1 'Groupe [22] 'Balise: 427, 7008 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,3})$ patterns.Add "$?(427|7008)$?(" + caracteresOK + "{0,3})" + fnc1 'Groupe [23] 'Balise: 4300, 4301, 4310, 4311, 4320 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,35})$ patterns.Add "$?(430[01]|431[01]|4320)$?(" + caracteresOK + "{0,35})" + fnc1 'Groupe [24] 'Balise: 4302 à 4306, 4312 à 4316, 8110, 8112, 8200 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,70})$ patterns.Add "$?(430[23456]|431[23456]|811[02]|8200)$?(" + caracteresOK + "{0,70})" + fnc1 'Groupe [25] 'Balise: 4307, 4317 'Pattern GS1: ^X([A-Z]{2})$ patterns.Add "$?(4307|4317)$?([A-Z]{2})" + fnc1 'Groupe [26] 'Balise: 7230 à 7239 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{2,30})$ patterns.Add "$?(723[0-9])$?(" + caracteresOK + "{2,30})" + fnc1 'Groupe [27] 'Balise: 4309 'Pattern GS1: ^4309(\d{20})$ patterns.Add "$?(4309)$?(\d{20})" + fnc1 'Groupe [28] 'Balise: 4321, 4322, 4323 'Pattern GS1: ^X([01])$ patterns.Add "$?(432[123])$?([01])" + fnc1 'Groupe [29] 'Balise: 4324, 4325, 7003 'Pattern GS1: ^X(\d{10})$ patterns.Add "$?(432[45]|7003)$?(\d{10})" + fnc1 'Groupe [30] 'Balise: 4326, 7006, 8005 'Pattern GS1: ^X(\d{6})$ patterns.Add "$?(4326|7006|8005)$?(\d{6})" + fnc1 'Groupe [31] 'Balise: 7001 'Pattern GS1: ^7001(\d{13})$ patterns.Add "$?(7001)$?(\d{13})" + fnc1 'Groupe [32] 'Balise: 7004 'Pattern GS1: ^7004(\d{0,4})$ patterns.Add "$?(7004)$?(\d{0,4})" + fnc1 'Groupe [33] 'Balise: 410 à 417 'Pattern GS1: ^X(\d{13})$ patterns.Add "$?(41[0-7])$?(\d{13})" + gs 'Groupe [34] 'Balise: 7005 'Pattern GS1: ^7005([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,12})$ patterns.Add "$?(7005)$?(" + caracteresOK + "{0,12})" + fnc1 'Groupe [35] 'Balise: 8006, 8026 'Pattern GS1: ^X(\d{14})(\d{2})(\d{2})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8006|8026)$?(\d{14}\d{2}\d{2})" + fnc1 'patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8006|8026)$?(\d{14})(\d{2})(\d{2})" + fnc1 'Groupe [36] 'Balise: 8007 'Pattern GS1: ^8007([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,34})$ patterns.Add "$?(8007)$?(" + caracteresOK + "{0,34})" + fnc1 'Groupe [37] 'Balise: 8008 'Pattern GS1: ^8008(\d{8})(\d{0,4})$ patterns.Add "$?(8007)$?(\d{8}\d{0,4})" + fnc1 'Groupe [38] 'Balise: 8009 'Pattern GS1: ^8009([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,50})$ patterns.Add "$?(8009)$?(" + caracteresOK + "{0,50})" + fnc1 'Groupe [39] 'Balise: 8010 'Pattern GS1: ^8010([\x23\x2D\x2F\x30-\x39\x41-\x5A]{5,30})$ patterns.Add "$?(8010)$?([\x23\x2D\x2F\x30-\x39\x41-\x5A]{5,30})" + fnc1 'Groupe [40] 'Balise: 7009 'Pattern GS1: ^7009([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,10})$ patterns.Add "$?(7009)$?(" + caracteresOK + "{0,10})" + fnc1 'Groupe [41] 'Balise: 7010 'Pattern GS1: ^7010([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,2})$ patterns.Add "$?(7010)$?(" + caracteresOK + "{0,2})" + fnc1 'Groupe [42] 'Balise: 7040 'Pattern GS1: ^7040(\d[\x21-\x22\x25-\x2F\x30-\x39\x41-\x5A\x5F\x61-\x7A]{3})$ patterns.Add "$?(7040)$?(\d[\x21\x22\x25-\x2F\x30-\x39\x41-\x5A\x5F\x61-\x7A]{3})" + fnc1 'Groupe [43] 'Balise: 8011 'Pattern GS1: ^8011(\d{0,12})$ patterns.Add "$?(8011)$?(\d{0,12})" + fnc1 'Groupe [44] 'Balise: 7030 à 7039 'Pattern GS1: ^X(\d{3})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,27})$ patterns.Add "$?(703[0-9])$?(\d{3}" + caracteresOK + "{0,27})" + fnc1 'Groupe [45] 'Balise: 8001 'Pattern GS1: ^8001(\d{14})$ patterns.Add "$?(8001)$?(\d{14})" + fnc1 'Groupe [46] 'Balise: 8003 'Pattern GS1: ^8003(\d{14})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,16})$ patterns.Add "$?(8003)$?(\d{14}" + caracteresOK + "{0,16})" + fnc1 'Groupe [47] 'Balise: 8013, 8020 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,25})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8013|8020)$?(" + caracteresOK + "{0,25})" + fnc1 'Groupe [48] 'Balise: 8017, 8018 'Pattern GS1: ^X(\d{18})$ patterns.Add "$?(801[78])$?(\d{18})" + fnc1 'Groupe [50] 'Balise: 91 à 99 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,90})$ patterns.Add "$?(9[1-9])$?(" + caracteresOK + "{0,90})" + fnc1 'valeur par défaut si la regex ne matche pas LigneHRI = "Code incorrect" LigneDecodeData = "" LigneControlData = "" Set resultats = New Collection Do boucleOut = False For Each pattern In patterns 'on teste chaque pattern pour le début du code regex.pattern = "^" + pattern If (regex.Test(Code)) Then boucleOut = True LigneHRI = "" 'si ça marche, on extrait la partie Set Match = regex.Execute(Code)(0) Set unCode = New unCode unCode.Init Match.SubMatches(0), Match.SubMatches(1) resultats.Add unCode 'on enlève ce qu'on vient de traiter Code = Replace(Code, Match.Value, "") 'et on recommence Exit For End If Next Loop While Len(Code) > 0 And boucleOut 'si boucleOut vaut false c'est qu'on vient de faire un tour complet et qu'on est sur un cas imprévu If boucleOut = False Then LigneHRI = "Erreur data imprévue !" ' + vbCrLf End If Dim ValidationData As Boolean Dim primaryKey, keyQualifier, dataAttribute, url As String ValidationData = True 'par défaut on considère que tout est correct For i = 1 To resultats.Count Set unCode = resultats(i) LigneHRI = LigneHRI + unCode.Texte LigneDecodeData = LigneDecodeData + unCode.Description + vbCrLf LigneControlData = LigneControlData + unCode.AdditionalDataInfo If unCode.ValidationData = False Then 's'il y a au moins une data incorrecte ça sera signalé ValidationData = False End If If unCode.IsPrimaryKey Then If primaryKey <> "" Then primaryKey = primaryKey + "/" 'si y'a déjà un primaryKey End If primaryKey = primaryKey + unCode.AI + "/" + unCode.Code 'construction de la partie d'url qui correspond aux AIs "primaryKey" End If If unCode.IsKeyQualifier Then keyQualifier = keyQualifier + "/" + unCode.AI + "/" + unCode.Code 'construction de la partie d'url qui correspond aux AIs "keyQualifier" End If If unCode.IsDataAttribute Then If dataAttribute <> "" Then dataAttribute = dataAttribute + "&" 'si y'a déjà un data attribute End If dataAttribute = dataAttribute + unCode.AI + "=" + unCode.Code 'construction de la partie d'url qui correspond aux AIs "dataAttribute" End If Next If ValidationData = False Then LigneControlData = vbCrLf + vbCrLf + "ATTENTION, vérifier les données de contrôle !" + vbCrLf + vbCrLf + LigneControlData End If url = "https://id.gs1.org/" + primaryKey + keyQualifier If dataAttribute <> "" Then 'Si pas de dataAttribute url = url + "?" + dataAttribute End If UserForm1.TextBox_Code_HRI = LigneHRI UserForm1.TextBox_All_Data = LigneDecodeData UserForm1.TextBox_Data_Controle = LigneControlData UserForm1.TextBox_Digital_Link_URI = url End Function Module de classe "unCode": Option Explicit 'Champs utiles Public AI As String Public Code As String Public AdditionalDataInfo As String Public Messages As String Public ValidationData As Boolean Public IsPrimaryKey As Boolean Public IsKeyQualifier As Boolean Public IsDataAttribute As Boolean 'Initialise l'instance de l'objet UnCode Public Sub Init(TheTag As String, TheCode As String) AI = TheTag Code = TheCode End Sub 'Méthode qui retourne un texte sous la forme "(Balise)TheCode" Public Function Texte() As String Texte = "(" & AI & ")" & Code End Function 'Méthode qui retourne un texte sous la forme "(Balise) Description : TheCode" Public Function Description() As String Dim madescription As String Dim TheCode As String Dim data As String Dim FormattedDate As String Dim OriginalDate As String TheCode = Code ValidationData = True Select Case AI Case "00" madescription = "(00) N° CONTENEUR (SSCC): " IsPrimaryKey = True data = Left(Code, 18) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "01" madescription = "(01) N° ARTICLE (GTIN): " IsPrimaryKey = True data = Left(Code, 14) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "02" madescription = "(02) N° ARTICLES CONTENUS: " IsDataAttribute = True data = Left(Code, 14) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "10" madescription = "(10) N° LOT: " IsKeyQualifier = True Case "11" madescription = "(11) DATE PRODUCTION: " IsDataAttribute = True OriginalDate = Code FormattedDate = CheckDate(Code) If CheckDate(OriginalDate) Then 'AdditionalDataInfo = "(" + AI + ") " + OriginalDate + " => " + FormattedDate AdditionalDataInfo = madescription + OriginalDate + " => " + FormattedDate Else 'AdditionalDataInfo = "(" + AI + ") " + OriginalDate + " => " + Messages AdditionalDataInfo = madescription + OriginalDate + " => " + Messages End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "12" madescription = "(12) DATE ECHEANCE: " IsDataAttribute = True Case "13" madescription = "(13) DATE EMBALLAGE: " IsDataAttribute = True Case "15" madescription = "(15) DATE PREREMPTION: " IsDataAttribute = True Case "16" madescription = "(16) DATE VENTE: " IsDataAttribute = True Case "17" madescription = "(17) DATE EXPIRATION: " IsDataAttribute = True OriginalDate = Code FormattedDate = CheckDate(Code) If CheckDate(OriginalDate) Then AdditionalDataInfo = madescription + OriginalDate + " => " + FormattedDate Else AdditionalDataInfo = madescription + OriginalDate + " => " + Messages End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "20" madescription = "(20) VARIANTE ARTICLE: " IsDataAttribute = True Case "21" madescription = "(21) N° SÉRIE: " IsKeyQualifier = True Case "22" madescription = "(22) VARIANTE PRODUIT: " IsKeyQualifier = True Case "235" madescription = "(235) EXTANSION CONTROLE: " IsKeyQualifier = True Case "240" madescription = "(240) ID ADDITIONNEL: " IsDataAttribute = True Case "241" madescription = "(241) N° PIECE: " IsDataAttribute = True Case "242" madescription = "(242) N° VARATION: " IsDataAttribute = True Case "243" madescription = "(243) N° EMBALAGE: " IsDataAttribute = True Case "250" madescription = "(250) N° SÉRIE SECONDAIRE: " IsDataAttribute = True Case "251" madescription = "(251) REF SOURCE: " IsDataAttribute = True Case "253" madescription = "(253) IDENTIFICATEUR DOC (GDTI): " IsPrimaryKey = True Case "254" madescription = "(254) COMPOSANT EXTENSION (GLN): " IsKeyQualifier = True Case "255" madescription = "(255) N° COUPON (GCN): " IsPrimaryKey = True Case "30" madescription = "(30) NB VARIABLE ARTICLES: " IsDataAttribute = True Case "37" madescription = "(37) COMPTAGE UNITÉ, log: " IsDataAttribute = True Case "3100", "3101", "3102", "3103", "3104", "3105" madescription = "(" + AI + ") POIDS NET (kg): " IsDataAttribute = True Case "3110", "3111", "3112", "3113", "3114", "3115" madescription = "(" + AI + ") LONGUEUR (m): " IsDataAttribute = True Case "3120", "3121", "3122", "3123", "3124", "3125" madescription = "(" + AI + ") LARGEUR (m): " IsDataAttribute = True Case "3130", "3131", "3132", "3133", "3134", "3135" madescription = "(" + AI + ") HAUTEUR (m): " IsDataAttribute = True Case "3140", "3141", "3142", "3143", "3144", "3145" madescription = "(" + AI + ") SUPERFICIE (m²): " IsDataAttribute = True Case "3150", "3151", "3152", "3153", "3154", "3155" madescription = "(" + AI + ") VOLUME NET (l): " IsDataAttribute = True Case "3160", "3161", "3162", "3163", "3164", "3165" madescription = "(" + AI + ") VOLUME NET (m³): " IsDataAttribute = True Case "3200", "3201", "3202", "3203", "3204", "3205" madescription = "(" + AI + ") POIDS NET (lb): " IsDataAttribute = True Case "3210", "3211", "3212", "3213", "3214", "3215" madescription = "(" + AI + ") LONGUEUR (in): " IsDataAttribute = True Case "3220", "3221", "3222", "3223", "3224", "3225" madescription = "(" + AI + ") LONGUEUR (ft): " IsDataAttribute = True Case "3230", "3231", "3232", "3233", "3234", "3235" madescription = "(" + AI + ") LONGUEUR (yd): " IsDataAttribute = True Case "3240", "3241", "3242", "3243", "3244", "3245" madescription = "(" + AI + ") LARGEUR (in): " IsDataAttribute = True Case "3250", "3251", "3252", "3253", "3254", "3255" madescription = "(" + AI + ") LARGEUR (ft): " IsDataAttribute = True Case "3260", "3261", "3262", "3263", "3264", "3265" madescription = "(" + AI + ") LARGEUR (yd): " IsDataAttribute = True Case "3270", "3271", "3272", "3273", "3274", "3275" madescription = "(" + AI + ") HAUTEUR (in): " IsDataAttribute = True Case "3280", "3281", "3282", "3283", "3284", "3285" madescription = "(" + AI + ") HAUTEUR (ft): " IsDataAttribute = True Case "3290", "3291", "3292", "3293", "3294", "3295" madescription = "(" + AI + ") HAUTEUR (yd): " IsDataAttribute = True Case "3300", "3301", "3302", "3303", "3304", "3305" madescription = "(" + AI + ") POIDS BRUT (kg): " IsDataAttribute = True Case "3310", "3311", "3312", "3313", "3314", "3315" madescription = "(" + AI + ") LONGUEUR (m), log: " IsDataAttribute = True Case "3320", "3321", "3322", "3323", "3324", "3325" madescription = "(" + AI + ") LARGEUR (m), grume: " IsDataAttribute = True Case "3330", "3331", "3332", "3333", "3334", "3335" madescription = "(" + AI + ") HAUTEUR (m), grume: " IsDataAttribute = True Case "3340", "3341", "3342", "3343", "3344", "3345" madescription = "(" + AI + ") SUPERFICIE (m²), log: " IsDataAttribute = True Case "3350", "3351", "3352", "3353", "3354", "3355" madescription = "(" + AI + ") VOLUME (l), log: " IsDataAttribute = True Case "3360", "3361", "3362", "3363", "3364", "3365" madescription = "(" + AI + ") VOLUME (m³), log: " IsDataAttribute = True Case "3370", "3371", "3372", "3373", "3374", "3375" madescription = "(" + AI + ") KG PAR m²: " IsDataAttribute = True Case "3400", "3401", "3402", "3403", "3404", "3405" madescription = "(" + AI + ") POIDS BRUT (lb): " IsDataAttribute = True Case "3410", "3411", "3412", "3413", "3414", "3415" madescription = "(" + AI + ") LONGUEUR (po), bille: " IsDataAttribute = True Case "3420", "3421", "3422", "3423", "3424", "3425" madescription = "(" + AI + ") LONGUEUR (ft), bille: " IsDataAttribute = True Case "3430", "3431", "3432", "3433", "3434", "3435" madescription = "(" + AI + ") LONGUEUR (yd), bille: " IsDataAttribute = True Case "3440", "3441", "3442", "3443", "3444", "3445" madescription = "(" + AI + ") LARGEUR (po), grume: " IsDataAttribute = True Case "3450", "3451", "3452", "3453", "3454", "3455" madescription = "(" + AI + ") LARGEUR (ft), grume: " IsDataAttribute = True Case "3460", "3461", "3462", "3463", "3464", "3465" madescription = "(" + AI + ") LARGEUR (yd), grume: " IsDataAttribute = True Case "3470", "3471", "3472", "3473", "3474", "3475" madescription = "(" + AI + ") HAUTEUR (po), grume: " IsDataAttribute = True Case "3480", "3481", "3482", "3483", "3484", "3485" madescription = "(" + AI + ") HAUTEUR (ft), grume: " IsDataAttribute = True Case "3490", "3491", "3492", "3493", "3494", "3495" madescription = "(" + AI + ") HAUTEUR (yd), grume: " IsDataAttribute = True Case "3500", "3501", "3502", "3503", "3504", "3505" madescription = "(" + AI + ") SUPERFICIE (in²): " IsDataAttribute = True Case "3510", "3511", "3512", "3513", "3514", "3515" madescription = "(" + AI + ") SURFACE (pi²): " IsDataAttribute = True Case "3520", "3521", "3522", "3523", "3524", "3525" madescription = "(" + AI + ") SUPERFICIE (yd²): " IsDataAttribute = True Case "3530", "3531", "3532", "3533", "3534", "3535" madescription = "(" + AI + ") SUPERFICIE (in²), log: " IsDataAttribute = True Case "3540", "3541", "3542", "3543", "3544", "3545" madescription = "(" + AI + ") SUPERFICIE (pi²), log: " IsDataAttribute = True Case "3550", "3551", "3552", "3553", "3554", "3555" madescription = "(" + AI + ") SUPERFICIE (yd²), log: " IsDataAttribute = True Case "3560", "3561", "3562", "3563", "3564", "3565" madescription = "(" + AI + ") POIDS NET (t oz): " IsDataAttribute = True Case "3570", "3571", "3572", "3573", "3574", "3575" madescription = "(" + AI + ") VOLUME NET (oz): " IsDataAttribute = True Case "3600", "3601", "3602", "3603", "3604", "3605" madescription = "(" + AI + ") VOLUME NET (qt): " IsDataAttribute = True Case "3610", "3611", "3612", "3613", "3614", "3615" madescription = "(" + AI + ") VOLUME NET (gal.): " IsDataAttribute = True Case "3620", "3621", "3622", "3623", "3624", "3625" madescription = "(" + AI + ") VOLUME (qt), log: " IsDataAttribute = True Case "3630", "3631", "3632", "3633", "3634", "3635" madescription = "(" + AI + ") VOLUME (gal.), log: " IsDataAttribute = True Case "3640", "3641", "3642", "3643", "3644", "3645" madescription = "(" + AI + ") VOLUME (po³): " IsDataAttribute = True Case "3650", "3651", "3652", "3653", "3654", "3655" madescription = "(" + AI + ") VOLUME (pi³): " IsDataAttribute = True Case "3660", "3661", "3662", "3663", "3664", "3665" madescription = "(" + AI + ") VOLUME (yd³): " IsDataAttribute = True Case "3670", "3671", "3672", "3673", "3674", "3675" madescription = "(" + AI + ") VOLUME (po³), bille: " IsDataAttribute = True Case "3680", "3681", "3682", "3683", "3684", "3685" madescription = "(" + AI + ") VOLUME (pi³), rondin: " IsDataAttribute = True Case "3690", "3691", "3692", "3693", "3694", "3695" madescription = "(" + AI + ") VOLUME (yd³), log: " IsDataAttribute = True Case "3900", "3901", "3902", "3903", "3904", "3905", "3906", "3907", "3908", "3909" madescription = "(" + AI + ") MONTANT: " IsDataAttribute = True Case "3910", "3911", "3912", "3913", "3914", "3915", "3916", "3917", "3918", "3919" madescription = "(" + AI + ") MONTANT (ISO): " IsDataAttribute = True Case "3920", "3921", "3922", "3923", "3924", "3925", "3926", "3927", "3928", "3929" madescription = "(" + AI + ") PRIX: " IsDataAttribute = True Case "3930", "3931", "3932", "3933", "3934", "3935", "3936", "3937", "3938", "3939" madescription = "(" + AI + ") PRIX (ISO): " IsDataAttribute = True Case "3940", "3941", "3942", "3943" madescription = "(" + AI + ") REMISE %: " IsDataAttribute = True Case "3950", "3951", "3952", "3953", "3954", "3955" madescription = "(" + AI + ") PRIX / UoM: " IsDataAttribute = True Case "400" madescription = "(400) NUMÉRO DE COMMANDE: " IsDataAttribute = True Case "401" madescription = "(401) N° INDENTIFICATION (GINC): " IsPrimaryKey = True Case "402" madescription = "(402) N° INDENTIFICATION (GSIN): " IsPrimaryKey = True Case "403" madescription = "(403) CODE ROUTAGE: " IsDataAttribute = True Case "410" madescription = "(410) EXPÉDIER À: " IsDataAttribute = True Case "411" madescription = "(411) FACTURER À: " IsDataAttribute = True Case "412" madescription = "(412) ACHAT AUPRÈS DE: " IsDataAttribute = True Case "413" madescription = "(413) EXPÉDIER POUR: " IsDataAttribute = True Case "414" madescription = "(414) N° LOC: " IsPrimaryKey = True Case "415" madescription = "(415) PAYER À: " IsPrimaryKey = True Case "416" madescription = "(416) PROD/SERV LOC: " IsDataAttribute = True Case "417" madescription = "(417) PARTIE: " IsPrimaryKey = True Case "420" madescription = "(420) EXPÉDIER CODE POSTAL: " IsDataAttribute = True Case "421" madescription = "(421) EXPÉDIER CODE POSTAL (ISO): " IsDataAttribute = True Case "422" madescription = "(422) ORIGINE: " IsDataAttribute = True Case "423" madescription = "(423) PROCESSUS INITIAL: " IsDataAttribute = True Case "424" madescription = "(424) PAYS - PROCESSUS: " IsDataAttribute = True Case "425" madescription = "(425) PAYS - DÉSASSEMBLAGE: " IsDataAttribute = True Case "426" madescription = "(426) PAYS - PROCESSUS COMPLET: " IsDataAttribute = True Case "427" madescription = "(427) SUBDIVISION ORIGINE: " IsDataAttribute = True Case "4300" madescription = "(4300) ENVOYER À SOCIÉTÉ: " IsDataAttribute = True Case "4301" madescription = "(4301) ENVOYER AU NOM: " IsDataAttribute = True Case "4302" madescription = "(4302) ENVOYER À ADD1: " IsDataAttribute = True Case "4303" madescription = "(4303) ENVOYER À ADD2: " IsDataAttribute = True Case "4304" madescription = "(4304) ENVOYER À BANLIEUE: " IsDataAttribute = True Case "4305" madescription = "(4305) ENVOYER À LOC: " IsDataAttribute = True Case "4306" madescription = "(4306) ENVOYER VERS REG: " IsDataAttribute = True Case "4307" madescription = "(4307) ENVOYER AU PAYS: " IsDataAttribute = True Case "4308" madescription = "(4308) ENVOYER AU TÉLÉPHONE: " IsDataAttribute = True Case "4309" madescription = "(4309) ENVOI VERS GEO: " IsDataAttribute = True Case "4310" madescription = "(4310) RETOUR À SOCIÉTÉ: " IsDataAttribute = True Case "4311" madescription = "(4311) RETOUR AU NOM: " IsDataAttribute = True Case "4312" madescription = "(4312) RETOUR À ADD1: " IsDataAttribute = True Case "4313" madescription = "(4313) RETOUR À ADD2: " IsDataAttribute = True Case "4314" madescription = "(4314) RETOUR EN BANLIEUE: " IsDataAttribute = True Case "4315" madescription = "(4315) RETOUR À LOC: " IsDataAttribute = True Case "4316" madescription = "(4316) RETOUR À REG: " IsDataAttribute = True Case "4317" madescription = "(4317) RETOUR AU PAYS: " IsDataAttribute = True Case "4318" madescription = "(4318) RETOUR CODE POSTAL: " IsDataAttribute = True Case "4319" madescription = "(4319) RETOUR AU TÉLÉPHONE: " IsDataAttribute = True Case "4320" madescription = "(4320) DESCRIPTION DU SERVICE: " IsDataAttribute = True Case "4321" madescription = "(4321) MARCHANDISES DANGEREUSES: " IsDataAttribute = True Case "4322" madescription = "(4322) AUTORISATION DE SORTIE: " IsDataAttribute = True Case "4323" madescription = "(4323) SIGNATURE REQUIS: " IsDataAttribute = True Case "4324" madescription = "(4324) PAS AVANT DATE: " IsDataAttribute = True Case "4325" madescription = "(4325) PAS APRES DATE: " IsDataAttribute = True Case "4326" madescription = "(4326) DATE DE SORTIE: " IsDataAttribute = True Case "7001" madescription = "(7001) N° STOCK OTAN (NSN): " IsDataAttribute = True Case "7002" madescription = "(7002) DÉCOUPE DE VIANDE: " IsDataAttribute = True Case "7003" madescription = "(7003) DATE DE PÉREMPTION: " IsDataAttribute = True Case "7004" madescription = "(7004) PUISSANCE ACTIVE: " IsDataAttribute = True Case "7005" madescription = "(7005) ZONE DE CAPTURE: " IsDataAttribute = True Case "7006" madescription = "(7006) DATE DE PREMIERE CONGELATION: " IsDataAttribute = True Case "7007" madescription = "(7007) DATE DE RÉCOLTE: " IsDataAttribute = True Case "7008" madescription = "(7008) ESPÈCES AQUATIQUES: " IsDataAttribute = True Case "7009" madescription = "(7009) TYPE D'ENGIN DE PÊCHE: " IsDataAttribute = True Case "7010" madescription = "(7010) MÉTHODE DE PRODUCTION: " IsDataAttribute = True Case "7011" madescription = "(7011) DATE LIMITE D'ESSAI: " IsDataAttribute = True Case "7020" madescription = "(7020) RÉNOVATION LOT: " IsDataAttribute = True Case "7021" madescription = "(7021) STATUS FONCTIONNEL: " IsDataAttribute = True Case "7022" madescription = "(7022) STATUS RÉVISION: " IsDataAttribute = True Case "7023" madescription = "(7023) ID ASSEMBLAGE(GIAI): " IsDataAttribute = True Case "7030" madescription = "(7030) PROCESSEUR ISO # 0: " IsDataAttribute = True Case "7031" madescription = "(7031) PROCESSEUR ISO # 1: " IsDataAttribute = True Case "7032" madescription = "(7032) PROCESSEUR ISO # 2: " IsDataAttribute = True Case "7033" madescription = "(7033) PROCESSEUR ISO # 3: " IsDataAttribute = True Case "7034" madescription = "(7034) PROCESSEUR ISO # 4: " IsDataAttribute = True Case "7035" madescription = "(7035) PROCESSEUR ISO # 5: " IsDataAttribute = True Case "7036" madescription = "(7036) PROCESSEUR ISO # 6: " IsDataAttribute = True Case "7037" madescription = "(7037) PROCESSEUR ISO # 7: " IsDataAttribute = True Case "7038" madescription = "(7038) PROCESSEUR ISO # 8: " IsDataAttribute = True Case "7039" madescription = "(7039) PROCESSEUR ISO # 9: " IsDataAttribute = True Case "7040" madescription = "(7040) UIC+EXT: " IsKeyQualifier = True Case "710" madescription = "(710) NHRN PZN: " IsDataAttribute = True Case "711" madescription = "(711) NHRN CIP: " IsDataAttribute = True Case "712" madescription = "(712) NHRN CN: " IsDataAttribute = True Case "713" madescription = "(713) NHRN DRN: " IsDataAttribute = True Case "714" madescription = "(714) NHRN AIM: " IsDataAttribute = True Case "715" madescription = "(715) NHRN NDC: " IsDataAttribute = True Case "7230" madescription = "(7230) CERT # 1: " IsDataAttribute = True Case "7231" madescription = "(7231) CERT # 2: " IsDataAttribute = True Case "7232" madescription = "(7232) CERT # 3: " IsDataAttribute = True Case "7233" madescription = "(7233) CERT # 4: " IsDataAttribute = True Case "7234" madescription = "(7234) CERT # 5: " IsDataAttribute = True Case "7235" madescription = "(7235) CERT # 6: " IsDataAttribute = True Case "7236" madescription = "(7236) CERT # 7: " IsDataAttribute = True Case "7237" madescription = "(7237) CERT # 8: " IsDataAttribute = True Case "7238" madescription = "(7238) CERT # 9: " IsDataAttribute = True Case "7239" madescription = "(7239) CERT # 10: " IsDataAttribute = True Case "7240" madescription = "(7240) PROTOCOLE: " IsDataAttribute = True Case "7241" madescription = "(7241) TYPE DE SUPPORT AIDC: " IsDataAttribute = True Case "7242" madescription = "(7242) VCN: " IsDataAttribute = True Case "8001" madescription = "(8001) DIMENSIONS: " IsDataAttribute = True Case "8002" madescription = "(8002) CMT No.: " IsDataAttribute = True Case "8003" madescription = "(8003) GRAI: " IsPrimaryKey = True Case "8004" madescription = "(8004) GIAI: " IsPrimaryKey = True Case "8005" madescription = "(8005) PRIX PAR UNITÉ: " IsDataAttribute = True Case "8006" Dim numero, totalSerie As Integer madescription = "(8006) ITIP: " IsPrimaryKey = True data = Left(Code, 14) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If numero = CInt(Mid(Code, 15, 2)) totalSerie = CInt(Right(Code, 2)) If numero = 0 Or totalSerie = 0 Or numero > totalSerie Then AdditionalDataInfo = "(" + AI + ") " + data + ", Erreur de numérotation." ValidationData = False End If 'AdditionalDataInfo = AdditionalDataInfo + vbCrLf + "(" + AI + ") " + data + ", pièce " + CStr(numero) + " sur " + CStr(totalSerie) + "." AdditionalDataInfo = AdditionalDataInfo + vbCrLf + "(" + AI + ") " + Format(CStr(numero), "00") + Format(CStr(totalSerie), "00") + ", pièce " + CStr(numero) + " sur " + CStr(totalSerie) + "." Case "8007" madescription = "(8007) IBAN: " IsDataAttribute = True Case "8008" madescription = "(8008) HEURE PRODUCTION: " IsDataAttribute = True Case "8009" madescription = "(8009) OPTSEN: " IsDataAttribute = True Case "8010" madescription = "(8010) CPID: " IsPrimaryKey = True Case "8011" madescription = "(8011) CPID SERIE: " IsKeyQualifier = True Case "8012" madescription = "(8012) VERSION: " IsDataAttribute = True Case "8013" madescription = "(8013) GMN: " IsPrimaryKey = True Case "8017" madescription = "(8017) GSRN - PRESTATAIRE: " IsPrimaryKey = True Case "8018" madescription = "(8018) GSRN - DESTINATAIRE: " IsPrimaryKey = True Case "8019" madescription = "(8019) SRIN: " IsKeyQualifier = True Case "8020" madescription = "(8020) REF No.: " IsKeyQualifier = True Case "8026" madescription = "(8026) CONTENU ITIP: " IsDataAttribute = True Case "8030" madescription = "(8030) DIGSIG: " IsDataAttribute = True Case "8110" madescription = "(8110) CODE COUPON: " IsDataAttribute = True Case "8111" madescription = "(8111) POINTS: " IsDataAttribute = True Case "8112" madescription = "(8112) ID COUPON: " IsDataAttribute = True Case "8200" madescription = "(8200) URL DU PRODUIT: " IsDataAttribute = True Case "90" madescription = "(90) INTERNE MUTUELLE: " IsDataAttribute = True Case "91", "92", "93", "94", "95", "96", "97", "98", "99" madescription = "(" + AI + ") N° INTERNE: " IsDataAttribute = True Case Else madescription = "(" + AI + ") Déscription non codée : " IsDataAttribute = True End Select Description = madescription + TheCode End Function Function CheckSum(data As String) As Boolean Dim s, key As Integer s = 0 Dim f As Integer Dim i As Integer Dim valeur As Variant key = CInt(Right(data, 1)) 'la clé c'est le carractère de droite valeur = Left(data, Len(data) - 1) 'la valeur c'est le reste 'facteur de départ en fonction de la longeur de la valeur If Len(valeur) Mod 2 = 0 Then f = 1 Else f = 3 End If For i = 1 To Len(valeur) s = s + CInt(Mid(valeur, i, 1)) * f f = 4 - f Next i 'on vérifie si la clé est bonne If s Mod 10 = 0 Then CheckSum = (key = 0) Else CheckSum = (key = 10 - s Mod 10) End If End Function Function CheckDate(strDate As String) As Date Dim dtDate As Date Dim YY As Integer, mm As Integer, dd As Integer ' A cette étape, la RegEx "$?(1[123567])$?(\d{6})" utilisée précédemment as validé qu'on as bien 6 chiffres! ' Pour les AIs, 11, 12, 13, 15, 16 et 17. ' If InStr(1, "0123456789", strDate) Then ' Debug.Print "Date doit être être composée de chiffres" ' End If ' If Len(strDate) < 6 Then ' Debug.Print "Date trop courte!" ' End If ' If Len(strDate) > 6 Then ' Debug.Print "Date trop longue!" ' End If YY = CInt(Left(strDate, 2)) mm = CInt(Mid(strDate, 3, 2)) dd = CInt(Right(strDate, 2)) YY = SetYear(YY, Year(Now)) ' YY = SetYear(YY, 2023) ' YY = SetYear(YY, 2049) ' YY = SetYear(YY, 2050) ' YY = SetYear(YY, 2051) ' YY = SetYear(YY, 2075) ' YY = SetYear(YY, 2099) ' Debug.Print YY If dd = 0 And (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) Then dd = 31 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 31 sera utilisé par défaut." 'Exit Function ElseIf dd = 0 And (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) Then dd = 30 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 30 sera utilisé par défaut." 'Exit Function ElseIf dd = 0 And mm = 2 Then If Not EstBissextile(YY) Then dd = 28 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 28 sera utilisé par défaut." 'Exit Function Else dd = 29 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 29 sera utilisé par défaut." 'Exit Function End If End If If mm < 1 Or mm > 12 Then Messages = "Erreur dans la date (mois " & mm & "), le mois doit être compris entre 1 et 12!" Exit Function End If If (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) And dd > 31 Then Messages = "Le mois de " & UCase(MonthName(mm)) & ", ne peut pas avoir plus de 31 jours!" Exit Function End If If (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) And dd > 30 Then Messages = "Le mois de " & UCase(MonthName(mm)) & ", ne peut pas avoir plus de 30 jours!" Exit Function End If If EstBissextile(YY) Then If mm = 2 And dd > 29 Then Messages = "Année bissextile, le mois de FEVRIER, ne peut pas avoir plus de 29 jours!" Exit Function End If Else If mm = 2 And dd > 28 Then Messages = "Année non bissextile, le mois de FEVRIER, ne peut pas avoir plus de 28 jours!" Exit Function End If End If dtDate = DateSerial(YY, mm, dd) 'Debug.Print strDate & " = " & dtDate CheckDate = dtDate End Function Function SetYear(YY As Integer, pivot As Integer) As Integer Dim current_year, siecle, temp, ecart As Integer current_year = pivot Mod 100 siecle = pivot - current_year temp = siecle + YY ecart = temp - pivot Do While ecart > 50 temp = temp - 100 ecart = temp - pivot Loop Do While ecart < -49 temp = temp + 100 ecart = temp - pivot Loop SetYear = temp End Function Function EstBissextile(Annee As Integer) As Boolean 'une année bissextile est divisible par 4 If Annee Mod 4 <> 0 Then EstBissextile = False Exit Function End If 'une année bissextile est divisible par 400 et par 100 en même temps, mais pas par 100 seul If Annee Mod 100 = 0 And Annee Mod 400 <> 0 Then EstBissextile = False Exit Function End If EstBissextile = True End Function L'UserForm Option Explicit Private FncList() As Variant Private Sub Button_Decode_Click() GS1_Resolver (TextBox_Code_ASCII.Value) End Sub Private Sub Button_Quitter_Click() Unload UserForm1 Application.Visible = True Application.Quit End Sub Private Sub Button_Reset_Click() 'Clear data TextBox_Code_Scanne.Text = "" TextBox_Code_ASCII.Text = "" TextBox_Code_HRI.Text = "" TextBox_Digital_Link_URI.Text = "" TextBox_All_Data.Text = "" TextBox_Data_Controle.Text = "" TextBox_Code_Scanne.SetFocus End Sub Private Sub Button_To_Excel_Click() Application.Visible = True Unload UserForm1 End Sub Private Sub Frame_Code_Scanne_Click() End Sub Private Sub TextBox_All_Data_Change() End Sub Private Sub TextBox_Code_HRI_Change() End Sub Private Sub TextBox_Code_Scanne_Change() End Sub 'NUL = Chr(0) , SOH = Chr(1) , STX = Chr(2) , ETX = Chr(3) , EOT = Chr(4) , ENQ = Chr(5) , ACK = Chr(6) , BEL = Chr(7) , BS = Chr(8) , HT = Chr(9) 'LF = Chr(10), VT = Chr(11), FF = Chr(12), CR = Chr(13), SO = Chr(14), SI = Chr(15), DLE = Chr(16), DC1 = Chr(17), DC2 = Chr(18), DC3 = Chr(19) 'DC4 = Chr(20), NAK = Chr(21), SYN = Chr(22), ETB = Chr(23), CAN = Chr(24), EM = Chr(25), SUB = Chr(26), ESC = Chr(27), FS = Chr(28), GS = Chr(29) 'RS = Chr(30), US = Chr(31), SP = Chr(32) Private Sub TextBox_Code_Scanne_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If KeyAscii > 31 And KeyAscii < 128 Then TextBox_Code_ASCII.Text = TextBox_Code_ASCII.Text & ChrW(KeyAscii) Else 'FncList = Array("NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI", "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB", "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US", "SP") FncList = Array(Chr(0), Chr(1), Chr(2), Chr(3), Chr(4), Chr(5), Chr(6), Chr(7), Chr(8), Chr(9), Chr(10), Chr(11), Chr(12), Chr(13), Chr(14), Chr(15), Chr(16), Chr(17), Chr(18), Chr(19), Chr(20), Chr(21), Chr(22), Chr(23), Chr(24), Chr(25), Chr(26), Chr(27), Chr(28), Chr(29), Chr(30), Chr(31), Chr(32)) 'If KeyAscii < 32 Then TextBox_Code_ASCII.Text = TextBox_Code_ASCII.Text & "<" & FncList(KeyAscii) & ">" If KeyAscii < 32 Then TextBox_Code_ASCII.Text = TextBox_Code_ASCII.Text & FncList(KeyAscii) 'If KeyAscii > 31 Then TextBox_Code_ASCII.Text = TextBox_Code_ASCII.Text & "<" & LTrim(Str(KeyAscii)) & ">" If KeyAscii > 31 Then TextBox_Code_ASCII.Text = TextBox_Code_ASCII.Text & LTrim(Str(KeyAscii)) End If End Sub Private Sub TextBox_Data_Controle_Change() End Sub Private Sub TextBox_Digital_Link_URI_Change() End Sub Private Sub TextBox_Digital_Link_URI_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If TextBox_Digital_Link_URI <> "" Then ActiveWorkbook.FollowHyperlink TextBox_Digital_Link_URI.Value, , True End Sub Private Sub UserForm_Click() End Sub Projet complet compressé "Zip". https://we.tl/t-FRXM9MvQHR

Whismeril · Answer

Pas testé, mais un truc dans le genre Dans UnCode, j'ai modifié (et regroupé) le traitement des 3 AI en question Case "22" 'prio 1 madescription = "(22) VARIANTE PRODUIT: " IsPriorityKeyQualifier = True Case "10" 'prio 2 madescription = "(10) N° LOT: " IsPriorityKeyQualifier = True Case "21" 'prio 3 madescription = "(21) N° SÉRIE: " IsPriorityKeyQualifier = True Et dans GS1_Resolver Dim ValidationData As Boolean Dim primaryKey, keyQualifier, dataAttribute, url As String 'Ajout Ici Dim priorityKeyQualifier As Variant Dim index As Integer priorityKeyQualifier = Array("", "", "") 'fin modif ValidationData = True 'par défaut on considère que tout est correct For i = 1 To resultats.Count Set unCode = resultats(i) LigneHRI = LigneHRI + unCode.Texte LigneDecodeData = LigneDecodeData + unCode.Description + vbCrLf LigneControlData = LigneControlData + unCode.AdditionalDataInfo If unCode.ValidationData = False Then 's'il y a au moins une data incorrecte ça sera signalé ValidationData = False End If 'Ajout ici If unCode.IsPriorityKeyQualifier Then Select Case unCode.AI Case "22" index = 0 Case "10" index = 1 Case Else index = 2 End Select priorityKeyQualifier(index) = "/" + unCode.AI + "/" + unCode.Code End If 'Fin modifs If unCode.IsPrimaryKey Then If primaryKey <> "" Then primaryKey = primaryKey + "/" 'si y'a déjà un primaryKey End If primaryKey = primaryKey + unCode.AI + "/" + unCode.Code 'construction de la partie d'url qui correspond aux AIs "primaryKey" End If If unCode.IsKeyQualifier Then keyQualifier = keyQualifier + "/" + unCode.AI + "/" + unCode.Code 'construction de la partie d'url qui correspond aux AIs "keyQualifier" End If If unCode.IsDataAttribute Then If dataAttribute <> "" Then dataAttribute = dataAttribute + "&" 'si y'a déjà un data attribute End If dataAttribute = dataAttribute + unCode.AI + "=" + unCode.Code 'construction de la partie d'url qui correspond aux AIs "dataAttribute" End If Next If ValidationData = False Then LigneControlData = vbCrLf + vbCrLf + "ATTENTION, vérifier les données de contrôle !" + vbCrLf + vbCrLf + LigneControlData End If 'ligne suivante modifiée url = "https://id.gs1.org/" + primaryKey + priorityKeyQualifier(0) + priorityKeyQualifier(1) + priorityKeyQualifier(2) + keyQualifier

NeriXs · Answer

Tous simplement parfait, Merci.

Juste eu à déclarer "IsPriorityKeyQualifier" en public dans le module de classe unCode.

Public IsPriorityKeyQualifier As Boolean

Whismeril · Answer

Au début de UnCode

Public IsPriorityKeyQualifier As Interger

'Initialise l'instance de l'objet UnCode
Public Sub Init(TheTag As String, TheCode As String)
    AI = TheTag
    Code = TheCode
    IsPriorityKeyQualifier = 99
End Sub

Dans le select case

Case "22" 'prio 1
            madescription = "(22) VARIANTE PRODUIT: "
            IsPriorityKeyQualifier = 0
                                  
        Case "10" 'prio 2
            madescription = "(10) N° LOT: "
            IsPriorityKeyQualifier = 1
            
        Case "21" 'prio 3
            madescription = "(21) N° SÉRIE: "
            IsPriorityKeyQualifier = 2

Et dans GS1_Resolver, on remplace le if sur IsPriorityKeyQualifier par

If unCode.IsPriorityKeyQualifier <> 99 Then
        priorityKeyQualifier(unCode.IsPriorityKeyQualifier) = "/" + unCode.AI + "/" + unCode.Code
    End If

NeriXs · Answer

J'aimerais pousser encore plus loin l'utilisation de priorityKeyQualifier
Comment pourrais-je "associer" ces priorityKeyQualifier "22, 10 et 21" aux PrimaryKey "01 et 8006"?

Whismeril · Answer

Comment ça associer?

NeriXs · Answer

En relisant mon précèdent message, je me rends compte que mon explication n'est pas très claire!
Je reprends:

Liste des 16 PrimaryKeys:
01, 8006, 8013, 8010, 414, 415, 417, 8017, 8018, 255, 00, 253, 401, 402, 8003 et 8004.

Liste des 9 KeyQualifiers:
22, 10, 21, 8011, 254, 8020, 8019, 235 et 7040.

-(1
- Les AIs 22, 10 et 21 sont des KeyQualifiers uniquement en présence des PrimaryKeys 01 et 8006 (ordre à respecter), dans les autres cas, ces AIs sont des DataAttributes.
-L'AI 8011 est un KeyQualifier uniquement en présence du PrimaryKey 8010, si non => DataAttribute.
-L'Ai 254 est un KeyQualifier uniquement en présence du PrimaryKey 414, si non => DataAttribute.
-L'AI 8020 est un KeyQualifier uniquement en présence du PrimaryKey 415, si non => DataAttribute.
-L'AI 8019 est un KeyQualifier uniquement en présence des PrimaryKeys 8017 et 8018, si non => DataAttribute.
-L'AI 235 est un KeyQualifier uniquement en présence du PrimaryKey 01, si non => DataAttribute.
-L'AI 7040 est un KeyQualifier uniquement en présence des PrimaryKeys 414, 417 et 8004, si non => DataAttribute.

-(2
Tous les KeyQualifiers en présence des PrimaryKeys 8013, 255, 00, 253, 401, 402, 8003 sont traités comme des DataAttributes.

Whismeril · Answer

Un début de réflexion, juste pour 8011. UnCode Option Explicit 'Champs utiles Public AI As String Public Code As String Public AdditionalDataInfo As String Public Messages As String Public ValidationData As Boolean Public IsPrimaryKey As Boolean Public IsKeyQualifier As Boolean Public IsPotentialyKeyQualifier As Collection 'ajout ici -------------------- Public IsDataAttribute As Boolean Public IsPriorityKeyQualifier As Interger 'Initialise l'instance de l'objet UnCode Public Sub Init(TheTag As String, TheCode As String) AI = TheTag Code = TheCode IsPriorityKeyQualifier = 99 Set IsPotentialyKeyQualifier = New Collection 'ajout ici---------------------- End Sub 'Méthode qui retourne un texte sous la forme "(Balise)TheCode" Public Function Texte() As String Texte = "(" & AI & ")" & Code End Function 'Méthode qui retourne un texte sous la forme "(Balise) Description : TheCode" Public Function Description() As String Dim madescription As String Dim TheCode As String Dim data As String Dim FormattedDate As String Dim OriginalDate As String TheCode = Code ValidationData = True Select Case AI Case "00" madescription = "(00) N° CONTENEUR (SSCC): " IsPrimaryKey = True data = Left(Code, 18) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "01" madescription = "(01) N° ARTICLE (GTIN): " IsPrimaryKey = True data = Left(Code, 14) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "02" madescription = "(02) N° ARTICLES CONTENUS: " IsDataAttribute = True data = Left(Code, 14) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "11" madescription = "(11) DATE PRODUCTION: " IsDataAttribute = True OriginalDate = Code FormattedDate = CheckDate(Code) If CheckDate(OriginalDate) Then 'AdditionalDataInfo = "(" + AI + ") " + OriginalDate + " => " + FormattedDate AdditionalDataInfo = madescription + OriginalDate + " => " + FormattedDate Else 'AdditionalDataInfo = "(" + AI + ") " + OriginalDate + " => " + Messages AdditionalDataInfo = madescription + OriginalDate + " => " + Messages End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "12" madescription = "(12) DATE ECHEANCE: " IsDataAttribute = True Case "13" madescription = "(13) DATE EMBALLAGE: " IsDataAttribute = True Case "15" madescription = "(15) DATE PREREMPTION: " IsDataAttribute = True Case "16" madescription = "(16) DATE VENTE: " IsDataAttribute = True Case "17" madescription = "(17) DATE EXPIRATION: " IsDataAttribute = True OriginalDate = Code FormattedDate = CheckDate(Code) If CheckDate(OriginalDate) Then AdditionalDataInfo = madescription + OriginalDate + " => " + FormattedDate Else AdditionalDataInfo = madescription + OriginalDate + " => " + Messages End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "20" madescription = "(20) VARIANTE ARTICLE: " IsDataAttribute = True Case "22" 'prio 1 madescription = "(22) VARIANTE PRODUIT: " IsPriorityKeyQualifier = 0 Case "10" 'prio 2 madescription = "(10) N° LOT: " IsPriorityKeyQualifier = 1 Case "21" 'prio 3 madescription = "(21) N° SÉRIE: " IsPriorityKeyQualifier = 2 Case "235" madescription = "(235) EXTANSION CONTROLE: " IsKeyQualifier = True Case "240" madescription = "(240) ID ADDITIONNEL: " IsDataAttribute = True Case "241" madescription = "(241) N° PIECE: " IsDataAttribute = True Case "242" madescription = "(242) N° VARATION: " IsDataAttribute = True Case "243" madescription = "(243) N° EMBALAGE: " IsDataAttribute = True Case "250" madescription = "(250) N° SÉRIE SECONDAIRE: " IsDataAttribute = True Case "251" madescription = "(251) REF SOURCE: " IsDataAttribute = True Case "253" madescription = "(253) IDENTIFICATEUR DOC (GDTI): " IsPrimaryKey = True Case "254" madescription = "(254) COMPOSANT EXTENSION (GLN): " IsKeyQualifier = True Case "255" madescription = "(255) N° COUPON (GCN): " IsPrimaryKey = True Case "30" madescription = "(30) NB VARIABLE ARTICLES: " IsDataAttribute = True Case "37" madescription = "(37) COMPTAGE UNITÉ, log: " IsDataAttribute = True Case "3100", "3101", "3102", "3103", "3104", "3105" madescription = "(" + AI + ") POIDS NET (kg): " IsDataAttribute = True Case "3110", "3111", "3112", "3113", "3114", "3115" madescription = "(" + AI + ") LONGUEUR (m): " IsDataAttribute = True Case "3120", "3121", "3122", "3123", "3124", "3125" madescription = "(" + AI + ") LARGEUR (m): " IsDataAttribute = True Case "3130", "3131", "3132", "3133", "3134", "3135" madescription = "(" + AI + ") HAUTEUR (m): " IsDataAttribute = True Case "3140", "3141", "3142", "3143", "3144", "3145" madescription = "(" + AI + ") SUPERFICIE (m²): " IsDataAttribute = True Case "3150", "3151", "3152", "3153", "3154", "3155" madescription = "(" + AI + ") VOLUME NET (l): " IsDataAttribute = True Case "3160", "3161", "3162", "3163", "3164", "3165" madescription = "(" + AI + ") VOLUME NET (m³): " IsDataAttribute = True Case "3200", "3201", "3202", "3203", "3204", "3205" madescription = "(" + AI + ") POIDS NET (lb): " IsDataAttribute = True Case "3210", "3211", "3212", "3213", "3214", "3215" madescription = "(" + AI + ") LONGUEUR (in): " IsDataAttribute = True Case "3220", "3221", "3222", "3223", "3224", "3225" madescription = "(" + AI + ") LONGUEUR (ft): " IsDataAttribute = True Case "3230", "3231", "3232", "3233", "3234", "3235" madescription = "(" + AI + ") LONGUEUR (yd): " IsDataAttribute = True Case "3240", "3241", "3242", "3243", "3244", "3245" madescription = "(" + AI + ") LARGEUR (in): " IsDataAttribute = True Case "3250", "3251", "3252", "3253", "3254", "3255" madescription = "(" + AI + ") LARGEUR (ft): " IsDataAttribute = True Case "3260", "3261", "3262", "3263", "3264", "3265" madescription = "(" + AI + ") LARGEUR (yd): " IsDataAttribute = True Case "3270", "3271", "3272", "3273", "3274", "3275" madescription = "(" + AI + ") HAUTEUR (in): " IsDataAttribute = True Case "3280", "3281", "3282", "3283", "3284", "3285" madescription = "(" + AI + ") HAUTEUR (ft): " IsDataAttribute = True Case "3290", "3291", "3292", "3293", "3294", "3295" madescription = "(" + AI + ") HAUTEUR (yd): " IsDataAttribute = True Case "3300", "3301", "3302", "3303", "3304", "3305" madescription = "(" + AI + ") POIDS BRUT (kg): " IsDataAttribute = True Case "3310", "3311", "3312", "3313", "3314", "3315" madescription = "(" + AI + ") LONGUEUR (m), log: " IsDataAttribute = True Case "3320", "3321", "3322", "3323", "3324", "3325" madescription = "(" + AI + ") LARGEUR (m), grume: " IsDataAttribute = True Case "3330", "3331", "3332", "3333", "3334", "3335" madescription = "(" + AI + ") HAUTEUR (m), grume: " IsDataAttribute = True Case "3340", "3341", "3342", "3343", "3344", "3345" madescription = "(" + AI + ") SUPERFICIE (m²), log: " IsDataAttribute = True Case "3350", "3351", "3352", "3353", "3354", "3355" madescription = "(" + AI + ") VOLUME (l), log: " IsDataAttribute = True Case "3360", "3361", "3362", "3363", "3364", "3365" madescription = "(" + AI + ") VOLUME (m³), log: " IsDataAttribute = True Case "3370", "3371", "3372", "3373", "3374", "3375" madescription = "(" + AI + ") KG PAR m²: " IsDataAttribute = True Case "3400", "3401", "3402", "3403", "3404", "3405" madescription = "(" + AI + ") POIDS BRUT (lb): " IsDataAttribute = True Case "3410", "3411", "3412", "3413", "3414", "3415" madescription = "(" + AI + ") LONGUEUR (po), bille: " IsDataAttribute = True Case "3420", "3421", "3422", "3423", "3424", "3425" madescription = "(" + AI + ") LONGUEUR (ft), bille: " IsDataAttribute = True Case "3430", "3431", "3432", "3433", "3434", "3435" madescription = "(" + AI + ") LONGUEUR (yd), bille: " IsDataAttribute = True Case "3440", "3441", "3442", "3443", "3444", "3445" madescription = "(" + AI + ") LARGEUR (po), grume: " IsDataAttribute = True Case "3450", "3451", "3452", "3453", "3454", "3455" madescription = "(" + AI + ") LARGEUR (ft), grume: " IsDataAttribute = True Case "3460", "3461", "3462", "3463", "3464", "3465" madescription = "(" + AI + ") LARGEUR (yd), grume: " IsDataAttribute = True Case "3470", "3471", "3472", "3473", "3474", "3475" madescription = "(" + AI + ") HAUTEUR (po), grume: " IsDataAttribute = True Case "3480", "3481", "3482", "3483", "3484", "3485" madescription = "(" + AI + ") HAUTEUR (ft), grume: " IsDataAttribute = True Case "3490", "3491", "3492", "3493", "3494", "3495" madescription = "(" + AI + ") HAUTEUR (yd), grume: " IsDataAttribute = True Case "3500", "3501", "3502", "3503", "3504", "3505" madescription = "(" + AI + ") SUPERFICIE (in²): " IsDataAttribute = True Case "3510", "3511", "3512", "3513", "3514", "3515" madescription = "(" + AI + ") SURFACE (pi²): " IsDataAttribute = True Case "3520", "3521", "3522", "3523", "3524", "3525" madescription = "(" + AI + ") SUPERFICIE (yd²): " IsDataAttribute = True Case "3530", "3531", "3532", "3533", "3534", "3535" madescription = "(" + AI + ") SUPERFICIE (in²), log: " IsDataAttribute = True Case "3540", "3541", "3542", "3543", "3544", "3545" madescription = "(" + AI + ") SUPERFICIE (pi²), log: " IsDataAttribute = True Case "3550", "3551", "3552", "3553", "3554", "3555" madescription = "(" + AI + ") SUPERFICIE (yd²), log: " IsDataAttribute = True Case "3560", "3561", "3562", "3563", "3564", "3565" madescription = "(" + AI + ") POIDS NET (t oz): " IsDataAttribute = True Case "3570", "3571", "3572", "3573", "3574", "3575" madescription = "(" + AI + ") VOLUME NET (oz): " IsDataAttribute = True Case "3600", "3601", "3602", "3603", "3604", "3605" madescription = "(" + AI + ") VOLUME NET (qt): " IsDataAttribute = True Case "3610", "3611", "3612", "3613", "3614", "3615" madescription = "(" + AI + ") VOLUME NET (gal.): " IsDataAttribute = True Case "3620", "3621", "3622", "3623", "3624", "3625" madescription = "(" + AI + ") VOLUME (qt), log: " IsDataAttribute = True Case "3630", "3631", "3632", "3633", "3634", "3635" madescription = "(" + AI + ") VOLUME (gal.), log: " IsDataAttribute = True Case "3640", "3641", "3642", "3643", "3644", "3645" madescription = "(" + AI + ") VOLUME (po³): " IsDataAttribute = True Case "3650", "3651", "3652", "3653", "3654", "3655" madescription = "(" + AI + ") VOLUME (pi³): " IsDataAttribute = True Case "3660", "3661", "3662", "3663", "3664", "3665" madescription = "(" + AI + ") VOLUME (yd³): " IsDataAttribute = True Case "3670", "3671", "3672", "3673", "3674", "3675" madescription = "(" + AI + ") VOLUME (po³), bille: " IsDataAttribute = True Case "3680", "3681", "3682", "3683", "3684", "3685" madescription = "(" + AI + ") VOLUME (pi³), rondin: " IsDataAttribute = True Case "3690", "3691", "3692", "3693", "3694", "3695" madescription = "(" + AI + ") VOLUME (yd³), log: " IsDataAttribute = True Case "3900", "3901", "3902", "3903", "3904", "3905", "3906", "3907", "3908", "3909" madescription = "(" + AI + ") MONTANT: " IsDataAttribute = True Case "3910", "3911", "3912", "3913", "3914", "3915", "3916", "3917", "3918", "3919" madescription = "(" + AI + ") MONTANT (ISO): " IsDataAttribute = True Case "3920", "3921", "3922", "3923", "3924", "3925", "3926", "3927", "3928", "3929" madescription = "(" + AI + ") PRIX: " IsDataAttribute = True Case "3930", "3931", "3932", "3933", "3934", "3935", "3936", "3937", "3938", "3939" madescription = "(" + AI + ") PRIX (ISO): " IsDataAttribute = True Case "3940", "3941", "3942", "3943" madescription = "(" + AI + ") REMISE %: " IsDataAttribute = True Case "3950", "3951", "3952", "3953", "3954", "3955" madescription = "(" + AI + ") PRIX / UoM: " IsDataAttribute = True Case "400" madescription = "(400) NUMÉRO DE COMMANDE: " IsDataAttribute = True Case "401" madescription = "(401) N° INDENTIFICATION (GINC): " IsPrimaryKey = True Case "402" madescription = "(402) N° INDENTIFICATION (GSIN): " IsPrimaryKey = True Case "403" madescription = "(403) CODE ROUTAGE: " IsDataAttribute = True Case "410" madescription = "(410) EXPÉDIER À: " IsDataAttribute = True Case "411" madescription = "(411) FACTURER À: " IsDataAttribute = True Case "412" madescription = "(412) ACHAT AUPRÈS DE: " IsDataAttribute = True Case "413" madescription = "(413) EXPÉDIER POUR: " IsDataAttribute = True Case "414" madescription = "(414) N° LOC: " IsPrimaryKey = True Case "415" madescription = "(415) PAYER À: " IsPrimaryKey = True Case "416" madescription = "(416) PROD/SERV LOC: " IsDataAttribute = True Case "417" madescription = "(417) PARTIE: " IsPrimaryKey = True Case "420" madescription = "(420) EXPÉDIER CODE POSTAL: " IsDataAttribute = True Case "421" madescription = "(421) EXPÉDIER CODE POSTAL (ISO): " IsDataAttribute = True Case "422" madescription = "(422) ORIGINE: " IsDataAttribute = True Case "423" madescription = "(423) PROCESSUS INITIAL: " IsDataAttribute = True Case "424" madescription = "(424) PAYS - PROCESSUS: " IsDataAttribute = True Case "425" madescription = "(425) PAYS - DÉSASSEMBLAGE: " IsDataAttribute = True Case "426" madescription = "(426) PAYS - PROCESSUS COMPLET: " IsDataAttribute = True Case "427" madescription = "(427) SUBDIVISION ORIGINE: " IsDataAttribute = True Case "4300" madescription = "(4300) ENVOYER À SOCIÉTÉ: " IsDataAttribute = True Case "4301" madescription = "(4301) ENVOYER AU NOM: " IsDataAttribute = True Case "4302" madescription = "(4302) ENVOYER À ADD1: " IsDataAttribute = True Case "4303" madescription = "(4303) ENVOYER À ADD2: " IsDataAttribute = True Case "4304" madescription = "(4304) ENVOYER À BANLIEUE: " IsDataAttribute = True Case "4305" madescription = "(4305) ENVOYER À LOC: " IsDataAttribute = True Case "4306" madescription = "(4306) ENVOYER VERS REG: " IsDataAttribute = True Case "4307" madescription = "(4307) ENVOYER AU PAYS: " IsDataAttribute = True Case "4308" madescription = "(4308) ENVOYER AU TÉLÉPHONE: " IsDataAttribute = True Case "4309" madescription = "(4309) ENVOI VERS GEO: " IsDataAttribute = True Case "4310" madescription = "(4310) RETOUR À SOCIÉTÉ: " IsDataAttribute = True Case "4311" madescription = "(4311) RETOUR AU NOM: " IsDataAttribute = True Case "4312" madescription = "(4312) RETOUR À ADD1: " IsDataAttribute = True Case "4313" madescription = "(4313) RETOUR À ADD2: " IsDataAttribute = True Case "4314" madescription = "(4314) RETOUR EN BANLIEUE: " IsDataAttribute = True Case "4315" madescription = "(4315) RETOUR À LOC: " IsDataAttribute = True Case "4316" madescription = "(4316) RETOUR À REG: " IsDataAttribute = True Case "4317" madescription = "(4317) RETOUR AU PAYS: " IsDataAttribute = True Case "4318" madescription = "(4318) RETOUR CODE POSTAL: " IsDataAttribute = True Case "4319" madescription = "(4319) RETOUR AU TÉLÉPHONE: " IsDataAttribute = True Case "4320" madescription = "(4320) DESCRIPTION DU SERVICE: " IsDataAttribute = True Case "4321" madescription = "(4321) MARCHANDISES DANGEREUSES: " IsDataAttribute = True Case "4322" madescription = "(4322) AUTORISATION DE SORTIE: " IsDataAttribute = True Case "4323" madescription = "(4323) SIGNATURE REQUIS: " IsDataAttribute = True Case "4324" madescription = "(4324) PAS AVANT DATE: " IsDataAttribute = True Case "4325" madescription = "(4325) PAS APRES DATE: " IsDataAttribute = True Case "4326" madescription = "(4326) DATE DE SORTIE: " IsDataAttribute = True Case "7001" madescription = "(7001) N° STOCK OTAN (NSN): " IsDataAttribute = True Case "7002" madescription = "(7002) DÉCOUPE DE VIANDE: " IsDataAttribute = True Case "7003" madescription = "(7003) DATE DE PÉREMPTION: " IsDataAttribute = True Case "7004" madescription = "(7004) PUISSANCE ACTIVE: " IsDataAttribute = True Case "7005" madescription = "(7005) ZONE DE CAPTURE: " IsDataAttribute = True Case "7006" madescription = "(7006) DATE DE PREMIERE CONGELATION: " IsDataAttribute = True Case "7007" madescription = "(7007) DATE DE RÉCOLTE: " IsDataAttribute = True Case "7008" madescription = "(7008) ESPÈCES AQUATIQUES: " IsDataAttribute = True Case "7009" madescription = "(7009) TYPE D'ENGIN DE PÊCHE: " IsDataAttribute = True Case "7010" madescription = "(7010) MÉTHODE DE PRODUCTION: " IsDataAttribute = True Case "7011" madescription = "(7011) DATE LIMITE D'ESSAI: " IsDataAttribute = True Case "7020" madescription = "(7020) RÉNOVATION LOT: " IsDataAttribute = True Case "7021" madescription = "(7021) STATUS FONCTIONNEL: " IsDataAttribute = True Case "7022" madescription = "(7022) STATUS RÉVISION: " IsDataAttribute = True Case "7023" madescription = "(7023) ID ASSEMBLAGE(GIAI): " IsDataAttribute = True Case "7030" madescription = "(7030) PROCESSEUR ISO # 0: " IsDataAttribute = True Case "7031" madescription = "(7031) PROCESSEUR ISO # 1: " IsDataAttribute = True Case "7032" madescription = "(7032) PROCESSEUR ISO # 2: " IsDataAttribute = True Case "7033" madescription = "(7033) PROCESSEUR ISO # 3: " IsDataAttribute = True Case "7034" madescription = "(7034) PROCESSEUR ISO # 4: " IsDataAttribute = True Case "7035" madescription = "(7035) PROCESSEUR ISO # 5: " IsDataAttribute = True Case "7036" madescription = "(7036) PROCESSEUR ISO # 6: " IsDataAttribute = True Case "7037" madescription = "(7037) PROCESSEUR ISO # 7: " IsDataAttribute = True Case "7038" madescription = "(7038) PROCESSEUR ISO # 8: " IsDataAttribute = True Case "7039" madescription = "(7039) PROCESSEUR ISO # 9: " IsDataAttribute = True Case "7040" madescription = "(7040) UIC+EXT: " IsKeyQualifier = True Case "710" madescription = "(710) NHRN PZN: " IsDataAttribute = True Case "711" madescription = "(711) NHRN CIP: " IsDataAttribute = True Case "712" madescription = "(712) NHRN CN: " IsDataAttribute = True Case "713" madescription = "(713) NHRN DRN: " IsDataAttribute = True Case "714" madescription = "(714) NHRN AIM: " IsDataAttribute = True Case "715" madescription = "(715) NHRN NDC: " IsDataAttribute = True Case "7230" madescription = "(7230) CERT # 1: " IsDataAttribute = True Case "7231" madescription = "(7231) CERT # 2: " IsDataAttribute = True Case "7232" madescription = "(7232) CERT # 3: " IsDataAttribute = True Case "7233" madescription = "(7233) CERT # 4: " IsDataAttribute = True Case "7234" madescription = "(7234) CERT # 5: " IsDataAttribute = True Case "7235" madescription = "(7235) CERT # 6: " IsDataAttribute = True Case "7236" madescription = "(7236) CERT # 7: " IsDataAttribute = True Case "7237" madescription = "(7237) CERT # 8: " IsDataAttribute = True Case "7238" madescription = "(7238) CERT # 9: " IsDataAttribute = True Case "7239" madescription = "(7239) CERT # 10: " IsDataAttribute = True Case "7240" madescription = "(7240) PROTOCOLE: " IsDataAttribute = True Case "7241" madescription = "(7241) TYPE DE SUPPORT AIDC: " IsDataAttribute = True Case "7242" madescription = "(7242) VCN: " IsDataAttribute = True Case "8001" madescription = "(8001) DIMENSIONS: " IsDataAttribute = True Case "8002" madescription = "(8002) CMT No.: " IsDataAttribute = True Case "8003" madescription = "(8003) GRAI: " IsPrimaryKey = True Case "8004" madescription = "(8004) GIAI: " IsPrimaryKey = True Case "8005" madescription = "(8005) PRIX PAR UNITÉ: " IsDataAttribute = True Case "8006" Dim numero, totalSerie As Integer madescription = "(8006) ITIP: " IsPrimaryKey = True data = Left(Code, 14) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If numero = CInt(Mid(Code, 15, 2)) totalSerie = CInt(Right(Code, 2)) If numero = 0 Or totalSerie = 0 Or numero > totalSerie Then AdditionalDataInfo = "(" + AI + ") " + data + ", Erreur de numérotation." ValidationData = False End If 'AdditionalDataInfo = AdditionalDataInfo + vbCrLf + "(" + AI + ") " + data + ", pièce " + CStr(numero) + " sur " + CStr(totalSerie) + "." AdditionalDataInfo = AdditionalDataInfo + vbCrLf + "(" + AI + ") " + Format(CStr(numero), "00") + Format(CStr(totalSerie), "00") + ", pièce " + CStr(numero) + " sur " + CStr(totalSerie) + "." Case "8007" madescription = "(8007) IBAN: " IsDataAttribute = True Case "8008" madescription = "(8008) HEURE PRODUCTION: " IsDataAttribute = True Case "8009" madescription = "(8009) OPTSEN: " IsDataAttribute = True Case "8010" madescription = "(8010) CPID: " IsPrimaryKey = True Case "8011" madescription = "(8011) CPID SERIE: " IsPotentialyKeyQualifier.Add "8010" 'ajout ici ------------------------ Case "8012" madescription = "(8012) VERSION: " IsDataAttribute = True Case "8013" madescription = "(8013) GMN: " IsPrimaryKey = True Case "8017" madescription = "(8017) GSRN - PRESTATAIRE: " IsPrimaryKey = True Case "8018" madescription = "(8018) GSRN - DESTINATAIRE: " IsPrimaryKey = True Case "8019" madescription = "(8019) SRIN: " IsKeyQualifier = True Case "8020" madescription = "(8020) REF No.: " IsKeyQualifier = True Case "8026" madescription = "(8026) CONTENU ITIP: " IsDataAttribute = True Case "8030" madescription = "(8030) DIGSIG: " IsDataAttribute = True Case "8110" madescription = "(8110) CODE COUPON: " IsDataAttribute = True Case "8111" madescription = "(8111) POINTS: " IsDataAttribute = True Case "8112" madescription = "(8112) ID COUPON: " IsDataAttribute = True Case "8200" madescription = "(8200) URL DU PRODUIT: " IsDataAttribute = True Case "90" madescription = "(90) INTERNE MUTUELLE: " IsDataAttribute = True Case "91", "92", "93", "94", "95", "96", "97", "98", "99" madescription = "(" + AI + ") N° INTERNE: " IsDataAttribute = True Case Else madescription = "(" + AI + ") Déscription non codée : " IsDataAttribute = True End Select Description = madescription + TheCode End Function Function CheckSum(data As String) As Boolean Dim s, key As Integer s = 0 Dim f As Integer Dim i As Integer Dim valeur As Variant key = CInt(Right(data, 1)) 'la clé c'est le carractère de droite valeur = Left(data, Len(data) - 1) 'la valeur c'est le reste 'facteur de départ en fonction de la longeur de la valeur If Len(valeur) Mod 2 = 0 Then f = 1 Else f = 3 End If For i = 1 To Len(valeur) s = s + CInt(Mid(valeur, i, 1)) * f f = 4 - f Next i 'on vérifie si la clé est bonne If s Mod 10 = 0 Then CheckSum = (key = 0) Else CheckSum = (key = 10 - s Mod 10) End If End Function Function CheckDate(strDate As String) As Date Dim dtDate As Date Dim YY As Integer, mm As Integer, dd As Integer ' A cette étape, la RegEx "$?(1[123567])$?(\d{6})" utilisée précédemment as validé qu'on as bien 6 chiffres! ' Pour les AIs, 11, 12, 13, 15, 16 et 17. ' If InStr(1, "0123456789", strDate) Then ' Debug.Print "Date doit être être composée de chiffres" ' End If ' If Len(strDate) < 6 Then ' Debug.Print "Date trop courte!" ' End If ' If Len(strDate) > 6 Then ' Debug.Print "Date trop longue!" ' End If YY = CInt(Left(strDate, 2)) mm = CInt(Mid(strDate, 3, 2)) dd = CInt(Right(strDate, 2)) YY = SetYear(YY, Year(Now)) ' YY = SetYear(YY, 2023) ' YY = SetYear(YY, 2049) ' YY = SetYear(YY, 2050) ' YY = SetYear(YY, 2051) ' YY = SetYear(YY, 2075) ' YY = SetYear(YY, 2099) ' Debug.Print YY If dd = 0 And (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) Then dd = 31 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 31 sera utilisé par défaut." 'Exit Function ElseIf dd = 0 And (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) Then dd = 30 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 30 sera utilisé par défaut." 'Exit Function ElseIf dd = 0 And mm = 2 Then If Not EstBissextile(YY) Then dd = 28 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 28 sera utilisé par défaut." 'Exit Function Else dd = 29 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 29 sera utilisé par défaut." 'Exit Function End If End If If mm < 1 Or mm > 12 Then Messages = "Erreur dans la date (mois " & mm & "), le mois doit être compris entre 1 et 12!" Exit Function End If If (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) And dd > 31 Then Messages = "Le mois de " & UCase(MonthName(mm)) & ", ne peut pas avoir plus de 31 jours!" Exit Function End If If (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) And dd > 30 Then Messages = "Le mois de " & UCase(MonthName(mm)) & ", ne peut pas avoir plus de 30 jours!" Exit Function End If If EstBissextile(YY) Then If mm = 2 And dd > 29 Then Messages = "Année bissextile, le mois de FEVRIER, ne peut pas avoir plus de 29 jours!" Exit Function End If Else If mm = 2 And dd > 28 Then Messages = "Année non bissextile, le mois de FEVRIER, ne peut pas avoir plus de 28 jours!" Exit Function End If End If dtDate = DateSerial(YY, mm, dd) 'Debug.Print strDate & " = " & dtDate CheckDate = dtDate End Function Function SetYear(YY As Integer, pivot As Integer) As Integer Dim current_year, siecle, temp, ecart As Integer current_year = pivot Mod 100 siecle = pivot - current_year temp = siecle + YY ecart = temp - pivot Do While ecart > 50 temp = temp - 100 ecart = temp - pivot Loop Do While ecart < -49 temp = temp + 100 ecart = temp - pivot Loop SetYear = temp End Function Function EstBissextile(Annee As Integer) As Boolean 'une année bissextile est divisible par 4 If Annee Mod 4 <> 0 Then EstBissextile = False Exit Function End If 'une année bissextile est divisible par 400 et par 100 en même temps, mais pas par 100 seul If Annee Mod 100 = 0 And Annee Mod 400 <> 0 Then EstBissextile = False Exit Function End If EstBissextile = True End Function Et dans GS1_Resolver priorityKeyQualifier = Array("", "", "") 'ajout ici -------------------- Dim previousPrimaryKeys Set previousPrimaryKeys = CreateObject("Scripting.Dictionary") 'fin modif ------------------- ValidationData = True 'par défaut on considère que tout est correct For i = 1 To resultats.Count Set unCode = resultats(i) LigneHRI = LigneHRI + unCode.Texte LigneDecodeData = LigneDecodeData + unCode.Description + vbCrLf LigneControlData = LigneControlData + unCode.AdditionalDataInfo If unCode.ValidationData = False Then 's'il y a au moins une data incorrecte ça sera signalé ValidationData = False End If If unCode.IsPriorityKeyQualifier <> 99 Then priorityKeyQualifier(unCode.IsPriorityKeyQualifier) = "/" + unCode.AI + "/" + unCode.Code End If If unCode.IsPrimaryKey Then If primaryKey <> "" Then primaryKey = primaryKey + "/" 'si y'a déjà un primaryKey End If primaryKey = primaryKey + unCode.AI + "/" + unCode.Code 'construction de la partie d'url qui correspond aux AIs "primaryKey" 'ajout ici-------------------------- previousPrimaryKeys.Add unCode.AI, 1 End If If unCode.IsPotentialyKeyQualifier.Count > 0 Then 'valeurs par défaut unCode.IsKeyQualifier = False unCode.IsDataAttribute = True For Each pKey In IsPotentialyKeyQualifier If previousPrimaryKeys.Exists(pKey) Then 'si le primaryKey est déjà présent (j'ai pas géré le cas où il arriverait plus loin dans le code barre, est-ce possible? unCode.IsKeyQualifier = True unCode.IsDataAttribute = False End If Next End If 'fin modifs----------------------------------- If unCode.IsKeyQualifier Then J'ai pas testé

NeriXs · Answer

J'ai déclaré les variables " previousPrimaryKeys", "pKey" et "IsPotentialyKeyQualifier" en Variant

Chargé la référence Microsoft Scripting Runtime pour le Dictionary

J'ai une incompatibilité de type sur :
For Each pKey In IsPotentialyKeyQualifier.

Je n'ai pas compris la question:
                'si le primaryKey est déjà présent (j'ai pas géré le cas où il arriverait plus loin dans le code barre, est-ce possible?

Test réalisé avec le code:
(8010)123456ABC(8011)123456

Whismeril · Answer

Je n'ai pas téléchargé ton projet, j'ai fait 2 corrections dans GS1 resolver et je lance par la sub test. À la fin, j'affiche un message box avec le décodage de chaque essai, j'ai commenté l'interaction avec l'USF que je n'ai pas. Pour illustrer la question que tu n'as pas comprise, j'ai ajouté un data attribute et j'ai changé l'ordre. Test + GS1_Resolver Option Explicit Sub test() 'ça c'est prévu GS1_Resolver "(8010)123456ABC(20)12(8011)123456" 'pas ça GS1_Resolver "(8011)123456(20)12(8010)123456ABC" End Sub Function GS1_Resolver(Code As String) As String Dim fnc1, gs, caracteresOK, pattern, LigneHRI, LigneDecodeData, LigneControlData As String Dim regex, Match As Object Dim i As Integer Dim resultats As Collection Dim unCode As unCode Dim boucleOut As Boolean Dim patterns As New Collection Set regex = New RegExp 'écriture des patterns unitaires gs = "(\x1d|$)?" 'quand c'est peut-être fnc1 = "(\x1d|$|\()" 'quand c'est obligé caracteresOK = "[\x21\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]" 'Groupe 1 'Balise: 00 'Pattern GS1: ^0(\d{18})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?\(?(00)$?(\d{18})" + gs 'Groupe [2] 'Balise: 01, 02 'Pattern GS1: ^X(\d{14})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(01|02)$?(\d{14})" + gs 'Groupe [3] 'Balise: 10, 21, 22, 243, 254, 420, 710, 711, 712, 713, 714, 715, 4318, 7020, 7021, 7022, 7240, 8002, 8012 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,20})$ patterns.Add "$?(10|2[12]|243|254|520|71[0-5]|4318|702[0-2]|7240|8002|8012)$?(" + caracteresOK + "{0,20})" + fnc1 'Groupe [4] 'Balise: 20 'Pattern GS1: ^20(\d{2})$ patterns.Add "$?(20)$?(\d{2})" + gs 'Groupe [5] 'Balise: 235 'Pattern GS1: ^235([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,28})$ patterns.Add "$?(235)$?(" + caracteresOK + "{0,28})" + fnc1 'Groupe [6] 'Balise: 90, 240, 241, 250, 251, 400, 401, 403, 4308, 4319, 7002, 7023, 8004 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,30})$ patterns.Add "$?(90|24[0-1]|25[0-1]|40[013]|4308|7319|7002|7023|8004)$?(" + caracteresOK + "{0,30})" + fnc1 'Groupe [7] 'Balise: 242 'Pattern GS1: ^242(\d{0,6})$ patterns.Add "$?(242)$?(\d{0,6})" + fnc1 'Groupe [8] 'Balise: 253 'Pattern GS1: ^253(\d{13})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,17})$ patterns.Add "$?(253)$?(\d{13}" + caracteresOK + "{0,17})" + fnc1 'Groupe [9] 'Balise: 255 'Pattern GS1: ^255(\d{13})(\d{0,12})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(255)$?(\d{13}\d{0,12})" + fnc1 'Groupe [10] 'Balise: 30, 37 'Pattern GS1: ^X(\d{0,8})$ patterns.Add "$?(3[07])$?(\d{0,8})" + fnc1 'Groupe [11] 'Balise: 11, 12, 13, 15, 16, 17 ' 3100 à 3105, 3110 à 3115, 3120 à 3125, 3130 à 3135, 3140 à 3145, 3150 à 3155, 3160 à 3165, ' 3300 à 3305, 3310 à 3315, 3320 à 3325, 3330 à 3335, 3340 à 3345, 3350 à 3355, 3360 à 3365, 3370 à 3375, ' 3500 à 3505, 3510 à 3515, 3520 à 3525, 3530 à 3535, 3540 à 3545, 3550 à 3555, 3560 à 3565, 3570 à 3575, ' 3200 à 3205, 3210 à 3215, 3220 à 3225, 3230 à 3235, 3240 à 3245, 3250 à 3255, 3260 à 3265, 3270 à 3275, 3280 à 3285, 3290 à 3295, ' 3400 à 3405, 3410 à 3415, 3420 à 3425, 3430 à 3435, 3440 à 3445, 3450 à 3455, 3460 à 3465, 3470 à 3475, 3480 à 3485, 3490 à 3495, ' 3600 à 3605, 3610 à 3615, 3620 à 3625, 3630 à 3635, 3640 à 3645, 3650 à 3655, 3660 à 3665, 3670 à 3675, 3680 à 3685, 3690 à 3695, 'Pattern GS1:^11(\d{6})$ patterns.Add "$?(1[123567]|31[0-6][0-5]|3[35][0-7][0-5]|3[246]\d[0-5])$?(\d{6})" + gs 'Groupe [12] 'Balise: 7007 'Pattern GS1: ^7007(\d{6,12})$ patterns.Add "$?(7007)$?(\d{6,12})" + fnc1 'Groupe [13] 'Balise: 7011 'Pattern GS1: ^7011(\d{6})(\d{0,4})$ patterns.Add "$?(7011)$?(\d{6}\d{0,4})" + fnc1 'Groupe [14] 'Balise: 3900 à 3909, 3920 à 3929 'Pattern GS1: ^X(\d{0,15})$ patterns.Add "$?(390[0-9]|392[0-9])$?(\d{0,15})" + fnc1 'Groupe [15] 'Balise: 3910 à 3919, 3930 à 3939 'Pattern GS1: ^X(\d{3})(\d{0,15})$ patterns.Add "$?(391[0-9]|393[0-9])$?(\d{3}\d{0,15})" + fnc1 'Groupe [16] 'Balise: 3940 à 3943, 8111 'Pattern GS1: ^X(\d{4})$ patterns.Add "$?(394[0-3]|8111)$?(\d{4})" + fnc1 'Groupe [17] 'Balise: 3950 à 3959 'Pattern GS1: ^X(\d{0,6})$ patterns.Add "$?(395[0-9])$?(\d{0,6})" + fnc1 'Groupe [18] 'Balise: 402 'Pattern GS1: ^402(\d{17})$ patterns.Add "$?(402)$?(\d{17})" + fnc1 'Groupe [19] 'Balise: 421 'Pattern GS1:^421(\d{3})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,9})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(421)$?(\d{3}" + caracteresOK + "{0,9})" + fnc1 'Groupe [20] 'Balise: 422, 424, 426 'Pattern GS1: ^X(\d{3})$ patterns.Add "$?(42[246])$?(\d{3})" + fnc1 'Groupe [21] 'Balise: 423, 425 'Pattern GS1: ^X(\d{3})(\d{0,12})$ patterns.Add "$?(423|425)$?(\d{3}\d{0,12})" + fnc1 'Groupe [22] 'Balise: 427, 7008 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,3})$ patterns.Add "$?(427|7008)$?(" + caracteresOK + "{0,3})" + fnc1 'Groupe [23] 'Balise: 4300, 4301, 4310, 4311, 4320 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,35})$ patterns.Add "$?(430[01]|431[01]|4320)$?(" + caracteresOK + "{0,35})" + fnc1 'Groupe [24] 'Balise: 4302 à 4306, 4312 à 4316, 8110, 8112, 8200 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,70})$ patterns.Add "$?(430[23456]|431[23456]|811[02]|8200)$?(" + caracteresOK + "{0,70})" + fnc1 'Groupe [25] 'Balise: 4307, 4317 'Pattern GS1: ^X([A-Z]{2})$ patterns.Add "$?(4307|4317)$?([A-Z]{2})" + fnc1 'Groupe [26] 'Balise: 7230 à 7239 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{2,30})$ patterns.Add "$?(723[0-9])$?(" + caracteresOK + "{2,30})" + fnc1 'Groupe [27] 'Balise: 4309 'Pattern GS1: ^4309(\d{20})$ patterns.Add "$?(4309)$?(\d{20})" + fnc1 'Groupe [28] 'Balise: 4321, 4322, 4323 'Pattern GS1: ^X([01])$ patterns.Add "$?(432[123])$?([01])" + fnc1 'Groupe [29] 'Balise: 4324, 4325, 7003 'Pattern GS1: ^X(\d{10})$ patterns.Add "$?(432[45]|7003)$?(\d{10})" + fnc1 'Groupe [30] 'Balise: 4326, 7006, 8005 'Pattern GS1: ^X(\d{6})$ patterns.Add "$?(4326|7006|8005)$?(\d{6})" + fnc1 'Groupe [31] 'Balise: 7001 'Pattern GS1: ^7001(\d{13})$ patterns.Add "$?(7001)$?(\d{13})" + fnc1 'Groupe [32] 'Balise: 7004 'Pattern GS1: ^7004(\d{0,4})$ patterns.Add "$?(7004)$?(\d{0,4})" + fnc1 'Groupe [33] 'Balise: 410 à 417 'Pattern GS1: ^X(\d{13})$ patterns.Add "$?(41[0-7])$?(\d{13})" + gs 'Groupe [34] 'Balise: 7005 'Pattern GS1: ^7005([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,12})$ patterns.Add "$?(7005)$?(" + caracteresOK + "{0,12})" + fnc1 'Groupe [35] 'Balise: 8006, 8026 'Pattern GS1: ^X(\d{14})(\d{2})(\d{2})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8006|8026)$?(\d{14}\d{2}\d{2})" + fnc1 'patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8006|8026)$?(\d{14})(\d{2})(\d{2})" + fnc1 'Groupe [36] 'Balise: 8007 'Pattern GS1: ^8007([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,34})$ patterns.Add "$?(8007)$?(" + caracteresOK + "{0,34})" + fnc1 'Groupe [37] 'Balise: 8008 'Pattern GS1: ^8008(\d{8})(\d{0,4})$ patterns.Add "$?(8007)$?(\d{8}\d{0,4})" + fnc1 'Groupe [38] 'Balise: 8009 'Pattern GS1: ^8009([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,50})$ patterns.Add "$?(8009)$?(" + caracteresOK + "{0,50})" + fnc1 'Groupe [39] 'Balise: 8010 'Pattern GS1: ^8010([\x23\x2D\x2F\x30-\x39\x41-\x5A]{5,30})$ patterns.Add "$?(8010)$?([\x23\x2D\x2F\x30-\x39\x41-\x5A]{5,30})" + fnc1 'Groupe [40] 'Balise: 7009 'Pattern GS1: ^7009([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,10})$ patterns.Add "$?(7009)$?(" + caracteresOK + "{0,10})" + fnc1 'Groupe [41] 'Balise: 7010 'Pattern GS1: ^7010([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,2})$ patterns.Add "$?(7010)$?(" + caracteresOK + "{0,2})" + fnc1 'Groupe [42] 'Balise: 7040 'Pattern GS1: ^7040(\d[\x21-\x22\x25-\x2F\x30-\x39\x41-\x5A\x5F\x61-\x7A]{3})$ patterns.Add "$?(7040)$?(\d[\x21\x22\x25-\x2F\x30-\x39\x41-\x5A\x5F\x61-\x7A]{3})" + fnc1 'Groupe [43] 'Balise: 8011 'Pattern GS1: ^8011(\d{0,12})$ patterns.Add "$?(8011)$?(\d{0,12})" + fnc1 'Groupe [44] 'Balise: 7030 à 7039 'Pattern GS1: ^X(\d{3})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,27})$ patterns.Add "$?(703[0-9])$?(\d{3}" + caracteresOK + "{0,27})" + fnc1 'Groupe [45] 'Balise: 8001 'Pattern GS1: ^8001(\d{14})$ patterns.Add "$?(8001)$?(\d{14})" + fnc1 'Groupe [46] 'Balise: 8003 'Pattern GS1: ^8003(\d{14})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,16})$ patterns.Add "$?(8003)$?(\d{14}" + caracteresOK + "{0,16})" + fnc1 'Groupe [47] 'Balise: 8013, 8020 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,25})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8013|8020)$?(" + caracteresOK + "{0,25})" + fnc1 'Groupe [48] 'Balise: 8017, 8018 'Pattern GS1: ^X(\d{18})$ patterns.Add "$?(801[78])$?(\d{18})" + fnc1 'Groupe [50] 'Balise: 91 à 99 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,90})$ patterns.Add "$?(9[1-9])$?(" + caracteresOK + "{0,90})" + fnc1 'valeur par défaut si la regex ne matche pas LigneHRI = "Code incorrect" LigneDecodeData = "" LigneControlData = "" Set resultats = New Collection Do boucleOut = False For Each pattern In patterns 'on teste chaque pattern pour le début du code regex.pattern = "^" + pattern If (regex.test(Code)) Then boucleOut = True LigneHRI = "" 'si ça marche, on extrait la partie Set Match = regex.Execute(Code)(0) Set unCode = New unCode unCode.Init Match.SubMatches(0), Match.SubMatches(1) resultats.Add unCode 'on enlève ce qu'on vient de traiter Code = Replace(Code, Match.Value, "") 'et on recommence Exit For End If Next Loop While Len(Code) > 0 And boucleOut 'si boucleOut vaut false c'est qu'on vient de faire un tour complet et qu'on est sur un cas imprévu If boucleOut = False Then LigneHRI = "Erreur data imprévue !" ' + vbCrLf End If Dim ValidationData As Boolean Dim primaryKey, keyQualifier, dataAttribute, url As String Dim priorityKeyQualifier As Variant Dim index As Integer priorityKeyQualifier = Array("", "", "") 'ajout ici -------------------- Dim previousPrimaryKeys Set previousPrimaryKeys = CreateObject("Scripting.Dictionary") 'fin modif ------------------- ValidationData = True 'par défaut on considère que tout est correct For i = 1 To resultats.Count Set unCode = resultats(i) LigneHRI = LigneHRI + unCode.Texte LigneDecodeData = LigneDecodeData + unCode.Description + vbCrLf LigneControlData = LigneControlData + unCode.AdditionalDataInfo If unCode.ValidationData = False Then 's'il y a au moins une data incorrecte ça sera signalé ValidationData = False End If If unCode.IsPriorityKeyQualifier <> 99 Then priorityKeyQualifier(unCode.IsPriorityKeyQualifier) = "/" + unCode.AI + "/" + unCode.Code End If If unCode.IsPrimaryKey Then If primaryKey <> "" Then primaryKey = primaryKey + "/" 'si y'a déjà un primaryKey End If primaryKey = primaryKey + unCode.AI + "/" + unCode.Code 'construction de la partie d'url qui correspond aux AIs "primaryKey" 'ajout ici-------------------------- previousPrimaryKeys.Add unCode.AI, 1 End If If unCode.IsPotentialyKeyQualifier.Count > 0 Then 'valeurs par défaut unCode.IsKeyQualifier = False unCode.IsDataAttribute = True Dim pKey For Each pKey In unCode.IsPotentialyKeyQualifier If previousPrimaryKeys.Exists(pKey) Then 'si le primaryKey est déjà présent (j'ai pas géré le cas où il arriverait plus loin dans le code barre, est-ce possible? unCode.IsKeyQualifier = True unCode.IsDataAttribute = False End If Next End If 'fin modifs----------------------------------- If unCode.IsKeyQualifier Then keyQualifier = keyQualifier + "/" + unCode.AI + "/" + unCode.Code 'construction de la partie d'url qui correspond aux AIs "keyQualifier" End If If unCode.IsDataAttribute Then If dataAttribute <> "" Then dataAttribute = dataAttribute + "&" 'si y'a déjà un data attribute End If dataAttribute = dataAttribute + unCode.AI + "=" + unCode.Code 'construction de la partie d'url qui correspond aux AIs "dataAttribute" End If Next If ValidationData = False Then LigneControlData = vbCrLf + vbCrLf + "ATTENTION, vérifier les données de contrôle !" + vbCrLf + vbCrLf + LigneControlData End If 'ligne suivante modifiée url = "https://id.gs1.org/" + primaryKey + priorityKeyQualifier(0) + priorityKeyQualifier(1) + priorityKeyQualifier(2) + keyQualifier If dataAttribute <> "" Then 'Si pas de dataAttribute url = url + "?" + dataAttribute End If 'UserForm1.TextBox_Code_HRI = LigneHRI 'UserForm1.TextBox_All_Data = LigneDecodeData 'UserForm1.TextBox_Data_Controle = LigneControlData 'UserForm1.TextBox_Digital_Link_URI = url MsgBox url End Function J'ai pas touché à UnCode

Whismeril · Answer

Finalement, on peut mettre un ordre sur tous les AIs:

Donc, à priori tu peux abandonner IsPrimaryKey, IsKeyQualifier, IsPotentialyKeyQualifier, IsDataAttribute et IsPriorityKeyQualifie et les remplacer par Index. Tu y colles l'index de chaque AI dans l'url.

de 0 à 15 pour 01, 8006, 8013, 8010, 414, 415, 417, 8017, 8018, 255, 00, 253, 401, 402, 8003 et 8004.
	de 16 à 24 pour 22, 10, 21, 8011, 254, 8020, 8019, 235 et 7040.
	etc..

Dans GS1_resolver, tu remplis un dictionnaire, dans lequel l'index est la clés et le contenu de l'url la valeur.

Et tu fusionnes le tout dans l'ordre des index du dictionnaire

Whismeril · Answer

J'ai fait pas mal de modifications et elles ne sont pas testées D'abord un module de plus (pour séparer les codes). Il n'est pas complet, il faut faire la suite et vérifier que ce qui est écrit je l'ai bien interprété Global Indices Sub InitIndices() Set Indices = CreateObject("Scripting.Dictionary") Indices.Add "01", 0 Indices.Add "8006", 1 Indices.Add "8013", 2 Indices.Add "8010", 3 Indices.Add "414", 4 Indices.Add "415", 5 Indices.Add "417", 6 Indices.Add "8017", 7 Indices.Add "8018", 8 Indices.Add "255", 9 Indices.Add "00", 10 Indices.Add "253", 11 Indices.Add "401", 12 Indices.Add "402", 13 Indices.Add "8003", 14 Indices.Add "8004", 15 Indices.Add "22", 16 Indices.Add "10", 17 Indices.Add "21", 18 Indices.Add "8011", 19 Indices.Add "254", 20 Indices.Add "8020", 21 Indices.Add "8019", 22 Indices.Add "235", 23 Indices.Add "7040", 24 Indices.Add "3100", 25 Indices.Add "3101", 26 Indices.Add "3102", 27 Indices.Add "3103", 28 Indices.Add "3104", 29 Indices.Add "3105", 30 Indices.Add "3200", 31 Indices.Add "3201", 32 Indices.Add "3202", 33 Indices.Add "3203", 34 Indices.Add "3204", 35 Indices.Add "3205", 36 Indices.Add "3560", 37 Indices.Add "3561", 38 Indices.Add "3562", 39 Indices.Add "3563", 40 Indices.Add "3564", 41 Indices.Add "3565", 42 Indices.Add "3570", 43 Indices.Add "3571", 44 Indices.Add "3572", 45 Indices.Add "3573", 46 Indices.Add "3574", 47 Indices.Add "3575", 48 'Il faut faire la suite End Sub UnCode Option Explicit 'Champs utiles Public AI As String Public Code As String Public AdditionalDataInfo As String Public Messages As String Public ValidationData As Boolean Public IsPotentialyKeyQualifier As Collection 'ajout ici -------------------- Public Url As String 'Initialise l'instance de l'objet UnCode Public Sub Init(TheTag As String, TheCode As String) AI = TheTag Code = TheCode Set IsPotentialyKeyQualifier = New Collection 'ajout ici---------------------- End Sub 'Méthode qui retourne un texte sous la forme "(Balise)TheCode" Public Function Texte() As String Texte = "(" & AI & ")" & Code End Function 'Méthode qui retourne un texte sous la forme "(Balise) Description : TheCode" Public Function Description() As String Dim madescription As String Dim TheCode As String Dim data As String Dim FormattedDate As String Dim OriginalDate As String TheCode = Code ValidationData = True Select Case AI Case "00" madescription = "(00) N° CONTENEUR (SSCC): " data = Left(Code, 18) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "01" madescription = "(01) N° ARTICLE (GTIN): " data = Left(Code, 14) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "02" madescription = "(02) N° ARTICLES CONTENUS: " data = Left(Code, 14) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "11" madescription = "(11) DATE PRODUCTION: " OriginalDate = Code FormattedDate = CheckDate(Code) If CheckDate(OriginalDate) Then 'AdditionalDataInfo = "(" + AI + ") " + OriginalDate + " => " + FormattedDate AdditionalDataInfo = madescription + OriginalDate + " => " + FormattedDate Else 'AdditionalDataInfo = "(" + AI + ") " + OriginalDate + " => " + Messages AdditionalDataInfo = madescription + OriginalDate + " => " + Messages End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "12" madescription = "(12) DATE ECHEANCE: " Case "13" madescription = "(13) DATE EMBALLAGE: " Case "15" madescription = "(15) DATE PREREMPTION: " Case "16" madescription = "(16) DATE VENTE: " Case "17" madescription = "(17) DATE EXPIRATION: " OriginalDate = Code FormattedDate = CheckDate(Code) If CheckDate(OriginalDate) Then AdditionalDataInfo = madescription + OriginalDate + " => " + FormattedDate Else AdditionalDataInfo = madescription + OriginalDate + " => " + Messages End If AdditionalDataInfo = AdditionalDataInfo + vbCrLf Case "20" madescription = "(20) VARIANTE ARTICLE: " Case "22" 'prio 1 madescription = "(22) VARIANTE PRODUIT: " Case "10" 'prio 2 madescription = "(10) N° LOT: " Case "21" 'prio 3 madescription = "(21) N° SÉRIE: " Case "235" madescription = "(235) EXTANSION CONTROLE: " Case "240" madescription = "(240) ID ADDITIONNEL: " Case "241" madescription = "(241) N° PIECE: " Case "242" madescription = "(242) N° VARATION: " Case "243" madescription = "(243) N° EMBALAGE: " Case "250" madescription = "(250) N° SÉRIE SECONDAIRE: " Case "251" madescription = "(251) REF SOURCE: " Case "253" madescription = "(253) IDENTIFICATEUR DOC (GDTI): " Case "254" madescription = "(254) COMPOSANT EXTENSION (GLN): " Case "255" madescription = "(255) N° COUPON (GCN): " Case "30" madescription = "(30) NB VARIABLE ARTICLES: " Case "37" madescription = "(37) COMPTAGE UNITÉ, log: " Case "3100", "3101", "3102", "3103", "3104", "3105" madescription = "(" + AI + ") POIDS NET (kg): " Case "3110", "3111", "3112", "3113", "3114", "3115" madescription = "(" + AI + ") LONGUEUR (m): " Case "3120", "3121", "3122", "3123", "3124", "3125" madescription = "(" + AI + ") LARGEUR (m): " Case "3130", "3131", "3132", "3133", "3134", "3135" madescription = "(" + AI + ") HAUTEUR (m): " Case "3140", "3141", "3142", "3143", "3144", "3145" madescription = "(" + AI + ") SUPERFICIE (m²): " Case "3150", "3151", "3152", "3153", "3154", "3155" madescription = "(" + AI + ") VOLUME NET (l): " Case "3160", "3161", "3162", "3163", "3164", "3165" madescription = "(" + AI + ") VOLUME NET (m³): " Case "3200", "3201", "3202", "3203", "3204", "3205" madescription = "(" + AI + ") POIDS NET (lb): " Case "3210", "3211", "3212", "3213", "3214", "3215" madescription = "(" + AI + ") LONGUEUR (in): " Case "3220", "3221", "3222", "3223", "3224", "3225" madescription = "(" + AI + ") LONGUEUR (ft): " Case "3230", "3231", "3232", "3233", "3234", "3235" madescription = "(" + AI + ") LONGUEUR (yd): " Case "3240", "3241", "3242", "3243", "3244", "3245" madescription = "(" + AI + ") LARGEUR (in): " Case "3250", "3251", "3252", "3253", "3254", "3255" madescription = "(" + AI + ") LARGEUR (ft): " Case "3260", "3261", "3262", "3263", "3264", "3265" madescription = "(" + AI + ") LARGEUR (yd): " Case "3270", "3271", "3272", "3273", "3274", "3275" madescription = "(" + AI + ") HAUTEUR (in): " Case "3280", "3281", "3282", "3283", "3284", "3285" madescription = "(" + AI + ") HAUTEUR (ft): " Case "3290", "3291", "3292", "3293", "3294", "3295" madescription = "(" + AI + ") HAUTEUR (yd): " Case "3300", "3301", "3302", "3303", "3304", "3305" madescription = "(" + AI + ") POIDS BRUT (kg): " Case "3310", "3311", "3312", "3313", "3314", "3315" madescription = "(" + AI + ") LONGUEUR (m), log: " Case "3320", "3321", "3322", "3323", "3324", "3325" madescription = "(" + AI + ") LARGEUR (m), grume: " Case "3330", "3331", "3332", "3333", "3334", "3335" madescription = "(" + AI + ") HAUTEUR (m), grume: " Case "3340", "3341", "3342", "3343", "3344", "3345" madescription = "(" + AI + ") SUPERFICIE (m²), log: " Case "3350", "3351", "3352", "3353", "3354", "3355" madescription = "(" + AI + ") VOLUME (l), log: " Case "3360", "3361", "3362", "3363", "3364", "3365" madescription = "(" + AI + ") VOLUME (m³), log: " Case "3370", "3371", "3372", "3373", "3374", "3375" madescription = "(" + AI + ") KG PAR m²: " Case "3400", "3401", "3402", "3403", "3404", "3405" madescription = "(" + AI + ") POIDS BRUT (lb): " Case "3410", "3411", "3412", "3413", "3414", "3415" madescription = "(" + AI + ") LONGUEUR (po), bille: " Case "3420", "3421", "3422", "3423", "3424", "3425" madescription = "(" + AI + ") LONGUEUR (ft), bille: " Case "3430", "3431", "3432", "3433", "3434", "3435" madescription = "(" + AI + ") LONGUEUR (yd), bille: " Case "3440", "3441", "3442", "3443", "3444", "3445" madescription = "(" + AI + ") LARGEUR (po), grume: " Case "3450", "3451", "3452", "3453", "3454", "3455" madescription = "(" + AI + ") LARGEUR (ft), grume: " Case "3460", "3461", "3462", "3463", "3464", "3465" madescription = "(" + AI + ") LARGEUR (yd), grume: " Case "3470", "3471", "3472", "3473", "3474", "3475" madescription = "(" + AI + ") HAUTEUR (po), grume: " Case "3480", "3481", "3482", "3483", "3484", "3485" madescription = "(" + AI + ") HAUTEUR (ft), grume: " Case "3490", "3491", "3492", "3493", "3494", "3495" madescription = "(" + AI + ") HAUTEUR (yd), grume: " Case "3500", "3501", "3502", "3503", "3504", "3505" madescription = "(" + AI + ") SUPERFICIE (in²): " Case "3510", "3511", "3512", "3513", "3514", "3515" madescription = "(" + AI + ") SURFACE (pi²): " Case "3520", "3521", "3522", "3523", "3524", "3525" madescription = "(" + AI + ") SUPERFICIE (yd²): " Case "3530", "3531", "3532", "3533", "3534", "3535" madescription = "(" + AI + ") SUPERFICIE (in²), log: " Case "3540", "3541", "3542", "3543", "3544", "3545" madescription = "(" + AI + ") SUPERFICIE (pi²), log: " Case "3550", "3551", "3552", "3553", "3554", "3555" madescription = "(" + AI + ") SUPERFICIE (yd²), log: " Case "3560", "3561", "3562", "3563", "3564", "3565" madescription = "(" + AI + ") POIDS NET (t oz): " Case "3570", "3571", "3572", "3573", "3574", "3575" madescription = "(" + AI + ") VOLUME NET (oz): " Case "3600", "3601", "3602", "3603", "3604", "3605" madescription = "(" + AI + ") VOLUME NET (qt): " Case "3610", "3611", "3612", "3613", "3614", "3615" madescription = "(" + AI + ") VOLUME NET (gal.): " Case "3620", "3621", "3622", "3623", "3624", "3625" madescription = "(" + AI + ") VOLUME (qt), log: " Case "3630", "3631", "3632", "3633", "3634", "3635" madescription = "(" + AI + ") VOLUME (gal.), log: " Case "3640", "3641", "3642", "3643", "3644", "3645" madescription = "(" + AI + ") VOLUME (po³): " Case "3650", "3651", "3652", "3653", "3654", "3655" madescription = "(" + AI + ") VOLUME (pi³): " Case "3660", "3661", "3662", "3663", "3664", "3665" madescription = "(" + AI + ") VOLUME (yd³): " Case "3670", "3671", "3672", "3673", "3674", "3675" madescription = "(" + AI + ") VOLUME (po³), bille: " Case "3680", "3681", "3682", "3683", "3684", "3685" madescription = "(" + AI + ") VOLUME (pi³), rondin: " Case "3690", "3691", "3692", "3693", "3694", "3695" madescription = "(" + AI + ") VOLUME (yd³), log: " Case "3900", "3901", "3902", "3903", "3904", "3905", "3906", "3907", "3908", "3909" madescription = "(" + AI + ") MONTANT: " Case "3910", "3911", "3912", "3913", "3914", "3915", "3916", "3917", "3918", "3919" madescription = "(" + AI + ") MONTANT (ISO): " Case "3920", "3921", "3922", "3923", "3924", "3925", "3926", "3927", "3928", "3929" madescription = "(" + AI + ") PRIX: " Case "3930", "3931", "3932", "3933", "3934", "3935", "3936", "3937", "3938", "3939" madescription = "(" + AI + ") PRIX (ISO): " Case "3940", "3941", "3942", "3943" madescription = "(" + AI + ") REMISE %: " Case "3950", "3951", "3952", "3953", "3954", "3955" madescription = "(" + AI + ") PRIX / UoM: " Case "400" madescription = "(400) NUMÉRO DE COMMANDE: " Case "401" madescription = "(401) N° INDENTIFICATION (GINC): " Case "402" madescription = "(402) N° INDENTIFICATION (GSIN): " Case "403" madescription = "(403) CODE ROUTAGE: " Case "410" madescription = "(410) EXPÉDIER À: " Case "411" madescription = "(411) FACTURER À: " Case "412" madescription = "(412) ACHAT AUPRÈS DE: " Case "413" madescription = "(413) EXPÉDIER POUR: " Case "414" madescription = "(414) N° LOC: " Case "415" madescription = "(415) PAYER À: " Case "416" madescription = "(416) PROD/SERV LOC: " Case "417" madescription = "(417) PARTIE: " Case "420" madescription = "(420) EXPÉDIER CODE POSTAL: " Case "421" madescription = "(421) EXPÉDIER CODE POSTAL (ISO): " Case "422" madescription = "(422) ORIGINE: " Case "423" madescription = "(423) PROCESSUS INITIAL: " Case "424" madescription = "(424) PAYS - PROCESSUS: " Case "425" madescription = "(425) PAYS - DÉSASSEMBLAGE: " Case "426" madescription = "(426) PAYS - PROCESSUS COMPLET: " Case "427" madescription = "(427) SUBDIVISION ORIGINE: " Case "4300" madescription = "(4300) ENVOYER À SOCIÉTÉ: " Case "4301" madescription = "(4301) ENVOYER AU NOM: " Case "4302" madescription = "(4302) ENVOYER À ADD1: " Case "4303" madescription = "(4303) ENVOYER À ADD2: " Case "4304" madescription = "(4304) ENVOYER À BANLIEUE: " Case "4305" madescription = "(4305) ENVOYER À LOC: " Case "4306" madescription = "(4306) ENVOYER VERS REG: " Case "4307" madescription = "(4307) ENVOYER AU PAYS: " Case "4308" madescription = "(4308) ENVOYER AU TÉLÉPHONE: " Case "4309" madescription = "(4309) ENVOI VERS GEO: " Case "4310" madescription = "(4310) RETOUR À SOCIÉTÉ: " Case "4311" madescription = "(4311) RETOUR AU NOM: " Case "4312" madescription = "(4312) RETOUR À ADD1: " Case "4313" madescription = "(4313) RETOUR À ADD2: " Case "4314" madescription = "(4314) RETOUR EN BANLIEUE: " Case "4315" madescription = "(4315) RETOUR À LOC: " Case "4316" madescription = "(4316) RETOUR À REG: " Case "4317" madescription = "(4317) RETOUR AU PAYS: " Case "4318" madescription = "(4318) RETOUR CODE POSTAL: " Case "4319" madescription = "(4319) RETOUR AU TÉLÉPHONE: " Case "4320" madescription = "(4320) DESCRIPTION DU SERVICE: " Case "4321" madescription = "(4321) MARCHANDISES DANGEREUSES: " Case "4322" madescription = "(4322) AUTORISATION DE SORTIE: " Case "4323" madescription = "(4323) SIGNATURE REQUIS: " Case "4324" madescription = "(4324) PAS AVANT DATE: " Case "4325" madescription = "(4325) PAS APRES DATE: " Case "4326" madescription = "(4326) DATE DE SORTIE: " Case "7001" madescription = "(7001) N° STOCK OTAN (NSN): " Case "7002" madescription = "(7002) DÉCOUPE DE VIANDE: " Case "7003" madescription = "(7003) DATE DE PÉREMPTION: " Case "7004" madescription = "(7004) PUISSANCE ACTIVE: " Case "7005" madescription = "(7005) ZONE DE CAPTURE: " Case "7006" madescription = "(7006) DATE DE PREMIERE CONGELATION: " Case "7007" madescription = "(7007) DATE DE RÉCOLTE: " Case "7008" madescription = "(7008) ESPÈCES AQUATIQUES: " Case "7009" madescription = "(7009) TYPE D'ENGIN DE PÊCHE: " Case "7010" madescription = "(7010) MÉTHODE DE PRODUCTION: " Case "7011" madescription = "(7011) DATE LIMITE D'ESSAI: " Case "7020" madescription = "(7020) RÉNOVATION LOT: " Case "7021" madescription = "(7021) STATUS FONCTIONNEL: " Case "7022" madescription = "(7022) STATUS RÉVISION: " Case "7023" madescription = "(7023) ID ASSEMBLAGE(GIAI): " Case "7030" madescription = "(7030) PROCESSEUR ISO # 0: " Case "7031" madescription = "(7031) PROCESSEUR ISO # 1: " Case "7032" madescription = "(7032) PROCESSEUR ISO # 2: " Case "7033" madescription = "(7033) PROCESSEUR ISO # 3: " Case "7034" madescription = "(7034) PROCESSEUR ISO # 4: " Case "7035" madescription = "(7035) PROCESSEUR ISO # 5: " Case "7036" madescription = "(7036) PROCESSEUR ISO # 6: " Case "7037" madescription = "(7037) PROCESSEUR ISO # 7: " Case "7038" madescription = "(7038) PROCESSEUR ISO # 8: " Case "7039" madescription = "(7039) PROCESSEUR ISO # 9: " Case "7040" madescription = "(7040) UIC+EXT: " Case "710" madescription = "(710) NHRN PZN: " Case "711" madescription = "(711) NHRN CIP: " Case "712" madescription = "(712) NHRN CN: " Case "713" madescription = "(713) NHRN DRN: " Case "714" madescription = "(714) NHRN AIM: " Case "715" madescription = "(715) NHRN NDC: " Case "7230" madescription = "(7230) CERT # 1: " Case "7231" madescription = "(7231) CERT # 2: " Case "7232" madescription = "(7232) CERT # 3: " Case "7233" madescription = "(7233) CERT # 4: " Case "7234" madescription = "(7234) CERT # 5: " Case "7235" madescription = "(7235) CERT # 6: " Case "7236" madescription = "(7236) CERT # 7: " Case "7237" madescription = "(7237) CERT # 8: " Case "7238" madescription = "(7238) CERT # 9: " Case "7239" madescription = "(7239) CERT # 10: " Case "7240" madescription = "(7240) PROTOCOLE: " Case "7241" madescription = "(7241) TYPE DE SUPPORT AIDC: " Case "7242" madescription = "(7242) VCN: " Case "8001" madescription = "(8001) DIMENSIONS: " Case "8002" madescription = "(8002) CMT No.: " Case "8003" madescription = "(8003) GRAI: " Case "8004" madescription = "(8004) GIAI: " Case "8005" madescription = "(8005) PRIX PAR UNITÉ: " Case "8006" Dim numero, totalSerie As Integer madescription = "(8006) ITIP: " data = Left(Code, 14) If CheckSum(data) Then AdditionalDataInfo = "(" + AI + ") " + data + ": Clé de contrôle valide!" Else AdditionalDataInfo = "(" + AI + ") " + data + ": ATTENTION, clé de contrôle non valide!" ValidationData = False End If numero = CInt(Mid(Code, 15, 2)) totalSerie = CInt(Right(Code, 2)) If numero = 0 Or totalSerie = 0 Or numero > totalSerie Then AdditionalDataInfo = "(" + AI + ") " + data + ", Erreur de numérotation." ValidationData = False End If 'AdditionalDataInfo = AdditionalDataInfo + vbCrLf + "(" + AI + ") " + data + ", pièce " + CStr(numero) + " sur " + CStr(totalSerie) + "." AdditionalDataInfo = AdditionalDataInfo + vbCrLf + "(" + AI + ") " + Format(CStr(numero), "00") + Format(CStr(totalSerie), "00") + ", pièce " + CStr(numero) + " sur " + CStr(totalSerie) + "." Case "8007" madescription = "(8007) IBAN: " Case "8008" madescription = "(8008) HEURE PRODUCTION: " Case "8009" madescription = "(8009) OPTSEN: " Case "8010" madescription = "(8010) CPID: " Case "8011" madescription = "(8011) CPID SERIE: " IsPotentialyKeyQualifier.Add "8010" 'ajout ici ------------------------ Case "8012" madescription = "(8012) VERSION: " Case "8013" madescription = "(8013) GMN: " Case "8017" madescription = "(8017) GSRN - PRESTATAIRE: " Case "8018" madescription = "(8018) GSRN - DESTINATAIRE: " Case "8019" madescription = "(8019) SRIN: " Case "8020" madescription = "(8020) REF No.: " Case "8026" madescription = "(8026) CONTENU ITIP: " Case "8030" madescription = "(8030) DIGSIG: " Case "8110" madescription = "(8110) CODE COUPON: " Case "8111" madescription = "(8111) POINTS: " Case "8112" madescription = "(8112) ID COUPON: " Case "8200" madescription = "(8200) URL DU PRODUIT: " Case "90" madescription = "(90) INTERNE MUTUELLE: " Case "91", "92", "93", "94", "95", "96", "97", "98", "99" madescription = "(" + AI + ") N° INTERNE: " Case Else madescription = "(" + AI + ") Déscription non codée : " End Select Description = madescription + TheCode Url = AI + "/" + Code + "/" End Function Function CheckSum(data As String) As Boolean Dim s, key As Integer s = 0 Dim f As Integer Dim i As Integer Dim valeur As Variant key = CInt(Right(data, 1)) 'la clé c'est le carractère de droite valeur = Left(data, Len(data) - 1) 'la valeur c'est le reste 'facteur de départ en fonction de la longeur de la valeur If Len(valeur) Mod 2 = 0 Then f = 1 Else f = 3 End If For i = 1 To Len(valeur) s = s + CInt(Mid(valeur, i, 1)) * f f = 4 - f Next i 'on vérifie si la clé est bonne If s Mod 10 = 0 Then CheckSum = (key = 0) Else CheckSum = (key = 10 - s Mod 10) End If End Function Function CheckDate(strDate As String) As Date Dim dtDate As Date Dim YY As Integer, mm As Integer, dd As Integer ' A cette étape, la RegEx "$?(1[123567])$?(\d{6})" utilisée précédemment as validé qu'on as bien 6 chiffres! ' Pour les AIs, 11, 12, 13, 15, 16 et 17. ' If InStr(1, "0123456789", strDate) Then ' Debug.Print "Date doit être être composée de chiffres" ' End If ' If Len(strDate) < 6 Then ' Debug.Print "Date trop courte!" ' End If ' If Len(strDate) > 6 Then ' Debug.Print "Date trop longue!" ' End If YY = CInt(Left(strDate, 2)) mm = CInt(Mid(strDate, 3, 2)) dd = CInt(Right(strDate, 2)) YY = SetYear(YY, Year(Now)) ' YY = SetYear(YY, 2023) ' YY = SetYear(YY, 2049) ' YY = SetYear(YY, 2050) ' YY = SetYear(YY, 2051) ' YY = SetYear(YY, 2075) ' YY = SetYear(YY, 2099) ' Debug.Print YY If dd = 0 And (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) Then dd = 31 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 31 sera utilisé par défaut." 'Exit Function ElseIf dd = 0 And (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) Then dd = 30 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 30 sera utilisé par défaut." 'Exit Function ElseIf dd = 0 And mm = 2 Then If Not EstBissextile(YY) Then dd = 28 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 28 sera utilisé par défaut." 'Exit Function Else dd = 29 'Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 29 sera utilisé par défaut." 'Exit Function End If End If If mm < 1 Or mm > 12 Then Messages = "Erreur dans la date (mois " & mm & "), le mois doit être compris entre 1 et 12!" Exit Function End If If (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) And dd > 31 Then Messages = "Le mois de " & UCase(MonthName(mm)) & ", ne peut pas avoir plus de 31 jours!" Exit Function End If If (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) And dd > 30 Then Messages = "Le mois de " & UCase(MonthName(mm)) & ", ne peut pas avoir plus de 30 jours!" Exit Function End If If EstBissextile(YY) Then If mm = 2 And dd > 29 Then Messages = "Année bissextile, le mois de FEVRIER, ne peut pas avoir plus de 29 jours!" Exit Function End If Else If mm = 2 And dd > 28 Then Messages = "Année non bissextile, le mois de FEVRIER, ne peut pas avoir plus de 28 jours!" Exit Function End If End If dtDate = DateSerial(YY, mm, dd) 'Debug.Print strDate & " = " & dtDate CheckDate = dtDate End Function Function SetYear(YY As Integer, pivot As Integer) As Integer Dim current_year, siecle, temp, ecart As Integer current_year = pivot Mod 100 siecle = pivot - current_year temp = siecle + YY ecart = temp - pivot Do While ecart > 50 temp = temp - 100 ecart = temp - pivot Loop Do While ecart < -49 temp = temp + 100 ecart = temp - pivot Loop SetYear = temp End Function Function EstBissextile(Annee As Integer) As Boolean 'une année bissextile est divisible par 4 If Annee Mod 4 <> 0 Then EstBissextile = False Exit Function End If 'une année bissextile est divisible par 400 et par 100 en même temps, mais pas par 100 seul If Annee Mod 100 = 0 And Annee Mod 400 <> 0 Then EstBissextile = False Exit Function End If EstBissextile = True End Function Et le module initial, Option Explicit Sub test() 'ça c'est prévu GS1_Resolver "(8010)123456ABC(20)12(8011)123456" End Sub Function GS1_Resolver(Code As String) As String Dim fnc1, gs, caracteresOK, pattern, LigneHRI, LigneDecodeData, LigneControlData As String Dim regex, Match As Object Dim i As Integer Dim resultats Dim key, pKey As Variant Dim unCode As unCode Dim boucleOut As Boolean Dim patterns As New Collection Dim Url As String Set regex = New RegExp Set resultats = CreateObject("Scripting.Dictionary") InitIndices 'écriture des patterns unitaires gs = "(\x1d|$)?" 'quand c'est peut-être fnc1 = "(\x1d|$|\()" 'quand c'est obligé caracteresOK = "[\x21\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]" 'Groupe 1 'Balise: 00 'Pattern GS1: ^0(\d{18})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?\(?(00)$?(\d{18})" + gs 'Groupe [2] 'Balise: 01, 02 'Pattern GS1: ^X(\d{14})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(01|02)$?(\d{14})" + gs 'Groupe [3] 'Balise: 10, 21, 22, 243, 254, 420, 710, 711, 712, 713, 714, 715, 4318, 7020, 7021, 7022, 7240, 8002, 8012 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,20})$ patterns.Add "$?(10|2[12]|243|254|520|71[0-5]|4318|702[0-2]|7240|8002|8012)$?(" + caracteresOK + "{0,20})" + fnc1 'Groupe [4] 'Balise: 20 'Pattern GS1: ^20(\d{2})$ patterns.Add "$?(20)$?(\d{2})" + gs 'Groupe [5] 'Balise: 235 'Pattern GS1: ^235([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,28})$ patterns.Add "$?(235)$?(" + caracteresOK + "{0,28})" + fnc1 'Groupe [6] 'Balise: 90, 240, 241, 250, 251, 400, 401, 403, 4308, 4319, 7002, 7023, 8004 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,30})$ patterns.Add "$?(90|24[0-1]|25[0-1]|40[013]|4308|7319|7002|7023|8004)$?(" + caracteresOK + "{0,30})" + fnc1 'Groupe [7] 'Balise: 242 'Pattern GS1: ^242(\d{0,6})$ patterns.Add "$?(242)$?(\d{0,6})" + fnc1 'Groupe [8] 'Balise: 253 'Pattern GS1: ^253(\d{13})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,17})$ patterns.Add "$?(253)$?(\d{13}" + caracteresOK + "{0,17})" + fnc1 'Groupe [9] 'Balise: 255 'Pattern GS1: ^255(\d{13})(\d{0,12})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(255)$?(\d{13}\d{0,12})" + fnc1 'Groupe [10] 'Balise: 30, 37 'Pattern GS1: ^X(\d{0,8})$ patterns.Add "$?(3[07])$?(\d{0,8})" + fnc1 'Groupe [11] 'Balise: 11, 12, 13, 15, 16, 17 ' 3100 à 3105, 3110 à 3115, 3120 à 3125, 3130 à 3135, 3140 à 3145, 3150 à 3155, 3160 à 3165, ' 3300 à 3305, 3310 à 3315, 3320 à 3325, 3330 à 3335, 3340 à 3345, 3350 à 3355, 3360 à 3365, 3370 à 3375, ' 3500 à 3505, 3510 à 3515, 3520 à 3525, 3530 à 3535, 3540 à 3545, 3550 à 3555, 3560 à 3565, 3570 à 3575, ' 3200 à 3205, 3210 à 3215, 3220 à 3225, 3230 à 3235, 3240 à 3245, 3250 à 3255, 3260 à 3265, 3270 à 3275, 3280 à 3285, 3290 à 3295, ' 3400 à 3405, 3410 à 3415, 3420 à 3425, 3430 à 3435, 3440 à 3445, 3450 à 3455, 3460 à 3465, 3470 à 3475, 3480 à 3485, 3490 à 3495, ' 3600 à 3605, 3610 à 3615, 3620 à 3625, 3630 à 3635, 3640 à 3645, 3650 à 3655, 3660 à 3665, 3670 à 3675, 3680 à 3685, 3690 à 3695, 'Pattern GS1:^11(\d{6})$ patterns.Add "$?(1[123567]|31[0-6][0-5]|3[35][0-7][0-5]|3[246]\d[0-5])$?(\d{6})" + gs 'Groupe [12] 'Balise: 7007 'Pattern GS1: ^7007(\d{6,12})$ patterns.Add "$?(7007)$?(\d{6,12})" + fnc1 'Groupe [13] 'Balise: 7011 'Pattern GS1: ^7011(\d{6})(\d{0,4})$ patterns.Add "$?(7011)$?(\d{6}\d{0,4})" + fnc1 'Groupe [14] 'Balise: 3900 à 3909, 3920 à 3929 'Pattern GS1: ^X(\d{0,15})$ patterns.Add "$?(390[0-9]|392[0-9])$?(\d{0,15})" + fnc1 'Groupe [15] 'Balise: 3910 à 3919, 3930 à 3939 'Pattern GS1: ^X(\d{3})(\d{0,15})$ patterns.Add "$?(391[0-9]|393[0-9])$?(\d{3}\d{0,15})" + fnc1 'Groupe [16] 'Balise: 3940 à 3943, 8111 'Pattern GS1: ^X(\d{4})$ patterns.Add "$?(394[0-3]|8111)$?(\d{4})" + fnc1 'Groupe [17] 'Balise: 3950 à 3959 'Pattern GS1: ^X(\d{0,6})$ patterns.Add "$?(395[0-9])$?(\d{0,6})" + fnc1 'Groupe [18] 'Balise: 402 'Pattern GS1: ^402(\d{17})$ patterns.Add "$?(402)$?(\d{17})" + fnc1 'Groupe [19] 'Balise: 421 'Pattern GS1:^421(\d{3})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,9})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(421)$?(\d{3}" + caracteresOK + "{0,9})" + fnc1 'Groupe [20] 'Balise: 422, 424, 426 'Pattern GS1: ^X(\d{3})$ patterns.Add "$?(42[246])$?(\d{3})" + fnc1 'Groupe [21] 'Balise: 423, 425 'Pattern GS1: ^X(\d{3})(\d{0,12})$ patterns.Add "$?(423|425)$?(\d{3}\d{0,12})" + fnc1 'Groupe [22] 'Balise: 427, 7008 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,3})$ patterns.Add "$?(427|7008)$?(" + caracteresOK + "{0,3})" + fnc1 'Groupe [23] 'Balise: 4300, 4301, 4310, 4311, 4320 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,35})$ patterns.Add "$?(430[01]|431[01]|4320)$?(" + caracteresOK + "{0,35})" + fnc1 'Groupe [24] 'Balise: 4302 à 4306, 4312 à 4316, 8110, 8112, 8200 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,70})$ patterns.Add "$?(430[23456]|431[23456]|811[02]|8200)$?(" + caracteresOK + "{0,70})" + fnc1 'Groupe [25] 'Balise: 4307, 4317 'Pattern GS1: ^X([A-Z]{2})$ patterns.Add "$?(4307|4317)$?([A-Z]{2})" + fnc1 'Groupe [26] 'Balise: 7230 à 7239 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{2,30})$ patterns.Add "$?(723[0-9])$?(" + caracteresOK + "{2,30})" + fnc1 'Groupe [27] 'Balise: 4309 'Pattern GS1: ^4309(\d{20})$ patterns.Add "$?(4309)$?(\d{20})" + fnc1 'Groupe [28] 'Balise: 4321, 4322, 4323 'Pattern GS1: ^X([01])$ patterns.Add "$?(432[123])$?([01])" + fnc1 'Groupe [29] 'Balise: 4324, 4325, 7003 'Pattern GS1: ^X(\d{10})$ patterns.Add "$?(432[45]|7003)$?(\d{10})" + fnc1 'Groupe [30] 'Balise: 4326, 7006, 8005 'Pattern GS1: ^X(\d{6})$ patterns.Add "$?(4326|7006|8005)$?(\d{6})" + fnc1 'Groupe [31] 'Balise: 7001 'Pattern GS1: ^7001(\d{13})$ patterns.Add "$?(7001)$?(\d{13})" + fnc1 'Groupe [32] 'Balise: 7004 'Pattern GS1: ^7004(\d{0,4})$ patterns.Add "$?(7004)$?(\d{0,4})" + fnc1 'Groupe [33] 'Balise: 410 à 417 'Pattern GS1: ^X(\d{13})$ patterns.Add "$?(41[0-7])$?(\d{13})" + gs 'Groupe [34] 'Balise: 7005 'Pattern GS1: ^7005([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,12})$ patterns.Add "$?(7005)$?(" + caracteresOK + "{0,12})" + fnc1 'Groupe [35] 'Balise: 8006, 8026 'Pattern GS1: ^X(\d{14})(\d{2})(\d{2})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8006|8026)$?(\d{14}\d{2}\d{2})" + fnc1 'patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8006|8026)$?(\d{14})(\d{2})(\d{2})" + fnc1 'Groupe [36] 'Balise: 8007 'Pattern GS1: ^8007([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,34})$ patterns.Add "$?(8007)$?(" + caracteresOK + "{0,34})" + fnc1 'Groupe [37] 'Balise: 8008 'Pattern GS1: ^8008(\d{8})(\d{0,4})$ patterns.Add "$?(8007)$?(\d{8}\d{0,4})" + fnc1 'Groupe [38] 'Balise: 8009 'Pattern GS1: ^8009([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,50})$ patterns.Add "$?(8009)$?(" + caracteresOK + "{0,50})" + fnc1 'Groupe [39] 'Balise: 8010 'Pattern GS1: ^8010([\x23\x2D\x2F\x30-\x39\x41-\x5A]{5,30})$ patterns.Add "$?(8010)$?([\x23\x2D\x2F\x30-\x39\x41-\x5A]{5,30})" + fnc1 'Groupe [40] 'Balise: 7009 'Pattern GS1: ^7009([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,10})$ patterns.Add "$?(7009)$?(" + caracteresOK + "{0,10})" + fnc1 'Groupe [41] 'Balise: 7010 'Pattern GS1: ^7010([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,2})$ patterns.Add "$?(7010)$?(" + caracteresOK + "{0,2})" + fnc1 'Groupe [42] 'Balise: 7040 'Pattern GS1: ^7040(\d[\x21-\x22\x25-\x2F\x30-\x39\x41-\x5A\x5F\x61-\x7A]{3})$ patterns.Add "$?(7040)$?(\d[\x21\x22\x25-\x2F\x30-\x39\x41-\x5A\x5F\x61-\x7A]{3})" + fnc1 'Groupe [43] 'Balise: 8011 'Pattern GS1: ^8011(\d{0,12})$ patterns.Add "$?(8011)$?(\d{0,12})" + fnc1 'Groupe [44] 'Balise: 7030 à 7039 'Pattern GS1: ^X(\d{3})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,27})$ patterns.Add "$?(703[0-9])$?(\d{3}" + caracteresOK + "{0,27})" + fnc1 'Groupe [45] 'Balise: 8001 'Pattern GS1: ^8001(\d{14})$ patterns.Add "$?(8001)$?(\d{14})" + fnc1 'Groupe [46] 'Balise: 8003 'Pattern GS1: ^8003(\d{14})([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,16})$ patterns.Add "$?(8003)$?(\d{14}" + caracteresOK + "{0,16})" + fnc1 'Groupe [47] 'Balise: 8013, 8020 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,25})$ patterns.Add "(?:](?:C1|e0|d2|Q3|J1))?$?(8013|8020)$?(" + caracteresOK + "{0,25})" + fnc1 'Groupe [48] 'Balise: 8017, 8018 'Pattern GS1: ^X(\d{18})$ patterns.Add "$?(801[78])$?(\d{18})" + fnc1 'Groupe [50] 'Balise: 91 à 99 'Pattern GS1: ^X([\x21-\x22\x25-\x2F\x30-\x39\x3A-\x3F\x41-\x5A\x5F\x61-\x7A]{0,90})$ patterns.Add "$?(9[1-9])$?(" + caracteresOK + "{0,90})" + fnc1 'valeur par défaut si la regex ne matche pas LigneHRI = "Code incorrect" LigneDecodeData = "" LigneControlData = "" Do boucleOut = False For Each pattern In patterns 'on teste chaque pattern pour le début du code regex.pattern = "^" + pattern If (regex.test(Code)) Then boucleOut = True LigneHRI = "" 'si ça marche, on extrait la partie Set Match = regex.Execute(Code)(0) Set unCode = New unCode unCode.Init Match.SubMatches(0), Match.SubMatches(1) resultats.Add unCode.AI, unCode 'on enlève ce qu'on vient de traiter Code = Replace(Code, Match.Value, "") 'et on recommence Exit For End If Next Loop While Len(Code) > 0 And boucleOut 'si boucleOut vaut false c'est qu'on vient de faire un tour complet et qu'on est sur un cas imprévu If boucleOut = False Then LigneHRI = "Erreur data imprévue !" ' + vbCrLf End If Dim ValidationData As Boolean ValidationData = True 'par défaut on considère que tout est correct Url = "https://id.gs1.org/" Dim dataAttribute As Boolean Dim hasDataAttribute As Boolean hasDataAttribute = False For Each key In Indices If resultats.Exists(key) Then Set unCode = resultats(key) LigneHRI = LigneHRI + unCode.Texte LigneDecodeData = LigneDecodeData + unCode.Description + vbCrLf LigneControlData = LigneControlData + unCode.AdditionalDataInfo If unCode.ValidationData = False Then 's'il y a au moins une data incorrecte ça sera signalé ValidationData = False End If dataAttribute = (Indices(unCode.AI) > 24) If Not dataAttribute And unCode.IsPotentialyKeyQualifier.Count > 0 Then dataAttribute = True For Each pKey In unCode.IsPotentialyKeyQualifier If resultats.Exists(pKey) Then dataAttribute = False Exit For End If Next End If If dataAttribute Then unCode.Url = Replace(unCode.Url, "/", "&") End If If Not hasDataAttribute And Right(unCode.Url, 1) = "&" Then hasDataAttribute = True Url = Left(Url, Len(Url) - 1) + "?" End If Url = Url + unCode.Url End If Next If ValidationData = False Then LigneControlData = vbCrLf + vbCrLf + "ATTENTION, vérifier les données de contrôle !" + vbCrLf + vbCrLf + LigneControlData End If Url = Left(Url, Len(Url) - 1) 'UserForm1.TextBox_Code_HRI = LigneHRI 'UserForm1.TextBox_All_Data = LigneDecodeData 'UserForm1.TextBox_Data_Controle = LigneControlData 'UserForm1.TextBox_Digital_Link_URI = url MsgBox Url End Function Si tu le testes tel quel, tu constateras que l'AI 20 n'apparait plus dans l'URL alors que dans mon code précédent si. C'est parce que tel que je comprends le message 237, je ne sais pas où le placer....

NeriXs · Answer

Bonjour,

Il va me falloir un plus de temps que je ne le pensais pour reprendre les cinq cent et quelque AIs pour les remettre en ordre.

J'ai joué un peu avec tes dernières modifications.
En testant ceci:

'GS1_Resolver "(01)00883873867792(10)220707(22)AvBn220707(21)PC22412085"
J'obtiens:
https://id.gs1.org/01/00883873867792/10/220707(22)AvBn220707/21/PC22412085

Selon l'ordre défini dans le nouveau module:

Indices.Add "22", 16
    Indices.Add "10", 17
    Indices.Add "21", 18

Je devrais avoir:
https://id.gs1.org/01/00883873867792/22/AvBn220707/10/220707/21/PC22412085

L'ordre n'est pas respecté.
J'ai ajouté 2 autres DataAttribute plus courant pour tester, soit

Indices.Add "11", 49
    Indices.Add "17", 50

J'obtiens:
https://id.gs1.org/01/00883873867792/22/AvBn220707/10/220707(17)241025/21/PC22412085?11&231025

Je devrais avoir:
https://id.gs1.org/01/00883873867792/22/AvBn220707/10/220707/21/PC22412085?17=241025&11=231025

L'ordre n'est pas respecté non plus et il y a un problème avec le "=" entre l'AI et la valeur qui n'est pas géré.

Je n'ai pas réussi à corriger.

NeriXs · Answer

Le module supplémentaire compété.

' #############################################
' #      Query chain construction order:      #
' #############################################

' 521 AIs - 2 en double = 519

' AI: 10 = lotCode, présent 2 fois car peut-être un Key qualifier (Indice N°17) ou un Data attribute (indice N°353)
' AI: 8020 = refNoCode, present 2 fois car peut-étre un Key qualifier (Indice N°21) ou un Data attribute (indice N°461)

' En présence du Primary key "00", l'AI "10" est un Data attribute.
' Dans les autres cas l'AI "10" est un Key qualifier.

'ATTENTION pour l'AI "8020" c'est de contraire de l'AI "10":

' En présence du Primary key "415", l'AI "8020" est un Key qualifier.
' Dans les autres cas l'AI "8020" est un Data attribute.

'Comment gérer ces "doublons" ???, en attendant les indices N° "353" et N° "461" ont étés commenté.

Global Indices

Sub InitIndices()

Set Indices = CreateObject("Scripting.Dictionary")
    
'### Primary key ###

'gtinCode / itipCode / gmnCode / cpidCode / glnCode /
'payToCode / partyGlnCode / gsrnpCode / gsrnCode / gcnCode /
'ssccCode / gdtiCode / gincCode / gsinCode / graiCode /
'giaiCode

'gtinCode
        Indices.Add "01", 0
    'itipCode
        Indices.Add "8006", 1
    'gmnCode
        Indices.Add "8013", 2
    'cpidCode
        Indices.Add "8010", 3
    'glnCode
        Indices.Add "414", 4
    'payToCode
        Indices.Add "415", 5
    'partyGlnCode
        Indices.Add "417", 6
    'gsrnpCode
        Indices.Add "8017", 7
    'gsrnCode
        Indices.Add "8018", 8
    'gcnCode
        Indices.Add "255", 9
    'ssccCode
        Indices.Add "00", 10
    'gdtiCode
        Indices.Add "253", 11
    'gincCode
        Indices.Add "401", 12
    'gsinCode
        Indices.Add "402", 13
    'graiCode
        Indices.Add "8003", 14
    'giaiCode
        Indices.Add "8004", 15
    
'### Key qualifier ###

'cpvCode / lotCode / serCode / cpsnCode / glnxCode /
'refNoCode / srinCode / tpxCode / uicExtCode

'cpvCode
        Indices.Add "22", 16
    'lotCode
        Indices.Add "10", 17
    'serCode
        Indices.Add "21", 18
    'cpsnCode
        Indices.Add "8011", 19
    'glnxCode
        Indices.Add "254", 20
    'refNoCode
        Indices.Add "8020", 21
    'srinCode
        Indices.Add "8019", 22
    'tpxCode
        Indices.Add "235", 23
    'uicExtCode
        Indices.Add "7040", 24
            
'### Data attribute ###

'netWeightVMTICode / lengthVMTICode / widthVMTICode / depthVMTICode / areaVMTICode /
'netVolumeVMTICode / massPerUnitAreaVMTICode / grossWeightCode / logisticLengthCode / logisticWidthCode /
'logisticDepthCode / logisticAreaCode / logisticVolumeCode / processorCode / LotCode /
'expiryDateCode / expiryTimeCode / contentCode / prodDateCode / dueDateCode /
'packDateCode / bestBeforeDateCode / sellByDateCode / firstFreezeDateCode / harvestDateCode /
'pricePerUnitCode / variantCode / varCountCode / countCode / amountPayPerUnitCode /
'additionalIdCode / custPartNoCode / mtoVariantCode / pcnCode / secondarySerialCode /
'refToSourceCode / amountCode / amountISOCode / priceCode / priceISOCode /
'percentOffCode / orderNumberCode / routeCode / shipToLocCode / billToCode /
'purchaseFromCode / shipForLocCode / prodServLocCode / shipToPostCode / shipToPostISOCode /
'originCode / countryProcessCode / countryFullProcessCode / countryInitialProcessCode / countryDisassemblyCode /
'originSubdivisionCode / nhrnPZNCode /nhrnCIPCode / nhrnCNCode / nhrnDRNCode /
'nsnCode / meatCutCode / activePotencyCode / catchAreaCode / fishingGearTypeCode /
'prodMethodCode / refurbLotCode / funcStatCode / revStatCode / giaiAssemblyCode /
'dimensionsCode / cmtNoCode / ibanCode / prodTimeCode / versionCode /
'refNoCode / couponIDNACode / pointsCode / itipContentCode / certificationRefCode /
'aquaticSpeciesCode / opticalSensorCode / paperlessCouponIDNACode / internalCode / mutualCode /
'extensionCode / shipToCompCode / shipToNameCode / shipToaAdd1Code / shipToaAdd2Code /
'shipToSubCode / shipToLocalityCode / shipToRegCode / shipToCountryCode / shipToPhoneCode /
'rtnToCompCode / rtnToNameCode / rtnToAdd1Code / rtnToAdd2Code / rtnToSubCode /
'rtnToLocCode / rtnToRegCode / rtnToCountryCode / rtnToPostCode / rtnToPhoneCode /
'srvDescriptionCode / dangerousGoodsCode / authToLeaveCode / sigRequiredCode / notBeforeDelDateCode /
'notAfterDelDateCode / releaseDateCode /

'netWeightVMTICode
        Indices.Add "3100", 25
        Indices.Add "3101", 26
        Indices.Add "3102", 27
        Indices.Add "3103", 28
        Indices.Add "3104", 29
        Indices.Add "3105", 30
        '
        Indices.Add "3200", 31
        Indices.Add "3201", 32
        Indices.Add "3202", 33
        Indices.Add "3203", 34
        Indices.Add "3204", 35
        Indices.Add "3205", 36
        '
        Indices.Add "3560", 37
        Indices.Add "3561", 38
        Indices.Add "3562", 39
        Indices.Add "3563", 40
        Indices.Add "3564", 41
        Indices.Add "3565", 42
        '
        Indices.Add "3570", 43
        Indices.Add "3571", 44
        Indices.Add "3572", 45
        Indices.Add "3573", 46
        Indices.Add "3574", 47
        Indices.Add "3575", 48
    'lengthVMTICode
        Indices.Add "3110", 49
        Indices.Add "3111", 50
        Indices.Add "3112", 51
        Indices.Add "3113", 52
        Indices.Add "3114", 53
        Indices.Add "3115", 54
        '
        Indices.Add "3210", 55
        Indices.Add "3211", 56
        Indices.Add "3212", 57
        Indices.Add "3213", 58
        Indices.Add "3214", 59
        Indices.Add "3215", 60
        '
        Indices.Add "3220", 61
        Indices.Add "3221", 62
        Indices.Add "3222", 63
        Indices.Add "3223", 64
        Indices.Add "3224", 65
        Indices.Add "3225", 66
        '
        Indices.Add "3230", 67
        Indices.Add "3231", 68
        Indices.Add "3232", 69
        Indices.Add "3233", 70
        Indices.Add "3234", 71
        Indices.Add "3235", 72
    'widthVMTICode
        Indices.Add "3120", 73
        Indices.Add "3121", 74
        Indices.Add "3122", 75
        Indices.Add "3123", 76
        Indices.Add "3124", 77
        Indices.Add "3125", 78
        '
        Indices.Add "3240", 79
        Indices.Add "3241", 80
        Indices.Add "3242", 81
        Indices.Add "3243", 82
        Indices.Add "3244", 83
        Indices.Add "3245", 84
        '
        Indices.Add "3250", 85
        Indices.Add "3251", 86
        Indices.Add "3252", 87
        Indices.Add "3253", 88
        Indices.Add "3254", 89
        Indices.Add "3255", 90
        '
        Indices.Add "3260", 91
        Indices.Add "3261", 92
        Indices.Add "3262", 93
        Indices.Add "3263", 94
        Indices.Add "3264", 95
        Indices.Add "3265", 96
    'depthVMTICode
        Indices.Add "3130", 97
        Indices.Add "3131", 98
        Indices.Add "3132", 99
        Indices.Add "3133", 100
        Indices.Add "3134", 101
        Indices.Add "3135", 102
        '
        Indices.Add "3270", 103
        Indices.Add "3271", 104
        Indices.Add "3272", 105
        Indices.Add "3273", 106
        Indices.Add "3274", 107
        Indices.Add "3275", 108
        '
        Indices.Add "3280", 109
        Indices.Add "3281", 110
        Indices.Add "3282", 111
        Indices.Add "3283", 112
        Indices.Add "3284", 113
        Indices.Add "3285", 114
        '
        Indices.Add "3290", 115
        Indices.Add "3291", 116
        Indices.Add "3292", 117
        Indices.Add "3293", 118
        Indices.Add "3294", 119
        Indices.Add "3295", 120
    'areaVMTICode
        Indices.Add "3140", 121
        Indices.Add "3141", 122
        Indices.Add "3142", 123
        Indices.Add "3143", 124
        Indices.Add "3144", 125
        Indices.Add "3145", 126
        '
        Indices.Add "3500", 127
        Indices.Add "3501", 128
        Indices.Add "3502", 129
        Indices.Add "3503", 130
        Indices.Add "3504", 131
        Indices.Add "3505", 132
        '
        Indices.Add "3510", 133
        Indices.Add "3511", 134
        Indices.Add "3512", 135
        Indices.Add "3513", 136
        Indices.Add "3514", 137
        Indices.Add "3515", 138
        '
        Indices.Add "3520", 139
        Indices.Add "3521", 140
        Indices.Add "3522", 141
        Indices.Add "3523", 142
        Indices.Add "3524", 143
        Indices.Add "3525", 144
    'netVolumeVMTICode
        Indices.Add "3150", 145
        Indices.Add "3151", 146
        Indices.Add "3152", 147
        Indices.Add "3153", 148
        Indices.Add "3154", 149
        Indices.Add "3155", 150
        '
        Indices.Add "3160", 151
        Indices.Add "3161", 152
        Indices.Add "3162", 153
        Indices.Add "3163", 154
        Indices.Add "3164", 155
        Indices.Add "3165", 156
        '
        Indices.Add "3600", 157
        Indices.Add "3601", 158
        Indices.Add "3602", 159
        Indices.Add "3603", 160
        Indices.Add "3604", 161
        Indices.Add "3605", 162
        '
        Indices.Add "3610", 163
        Indices.Add "3611", 164
        Indices.Add "3612", 165
        Indices.Add "3613", 166
        Indices.Add "3614", 167
        Indices.Add "3615", 168
        '
        Indices.Add "3640", 169
        Indices.Add "3641", 170
        Indices.Add "3642", 171
        Indices.Add "3643", 172
        Indices.Add "3644", 173
        Indices.Add "3645", 174
        '
        Indices.Add "3650", 175
        Indices.Add "3651", 176
        Indices.Add "3652", 177
        Indices.Add "3653", 178
        Indices.Add "3654", 179
        Indices.Add "3655", 180
        '
        Indices.Add "3660", 181
        Indices.Add "3661", 182
        Indices.Add "3662", 183
        Indices.Add "3663", 184
        Indices.Add "3664", 185
        Indices.Add "3665", 186
    'massPerUnitAreaVMTICode
        Indices.Add "3370", 187
        Indices.Add "3371", 188
        Indices.Add "3372", 189
        Indices.Add "3373", 190
        Indices.Add "3374", 191
        Indices.Add "3375", 192
    'grossWeightCode
        Indices.Add "3300", 193
        Indices.Add "3301", 194
        Indices.Add "3302", 195
        Indices.Add "3303", 196
        Indices.Add "3304", 197
        Indices.Add "3305", 198
        '
        Indices.Add "3400", 199
        Indices.Add "3401", 200
        Indices.Add "3402", 201
        Indices.Add "3403", 202
        Indices.Add "3404", 203
        Indices.Add "3405", 204
    'logisticLengthCode
        Indices.Add "3310", 205
        Indices.Add "3311", 206
        Indices.Add "3312", 207
        Indices.Add "3313", 208
        Indices.Add "3314", 209
        Indices.Add "3315", 210
        '
        Indices.Add "3410", 211
        Indices.Add "3411", 212
        Indices.Add "3412", 213
        Indices.Add "3413", 214
        Indices.Add "3414", 215
        Indices.Add "3415", 216
        '
        Indices.Add "3420", 217
        Indices.Add "3421", 218
        Indices.Add "3422", 219
        Indices.Add "3423", 220
        Indices.Add "3424", 221
        Indices.Add "3425", 222
        '
        Indices.Add "3430", 223
        Indices.Add "3431", 224
        Indices.Add "3432", 225
        Indices.Add "3433", 226
        Indices.Add "3434", 227
        Indices.Add "3435", 228
    'logisticWidthCode
        Indices.Add "3320", 229
        Indices.Add "3321", 230
        Indices.Add "3322", 231
        Indices.Add "3323", 232
        Indices.Add "3324", 233
        Indices.Add "3325", 234
        '
        Indices.Add "3440", 235
        Indices.Add "3441", 236
        Indices.Add "3442", 237
        Indices.Add "3443", 238
        Indices.Add "3444", 239
        Indices.Add "3445", 240
        '
        Indices.Add "3450", 241
        Indices.Add "3451", 242
        Indices.Add "3452", 243
        Indices.Add "3453", 244
        Indices.Add "3454", 245
        Indices.Add "3455", 246
        '
        Indices.Add "3460", 247
        Indices.Add "3461", 248
        Indices.Add "3462", 249
        Indices.Add "3463", 250
        Indices.Add "3464", 251
        Indices.Add "3465", 252
    'logisticDepthCode
        Indices.Add "3330", 253
        Indices.Add "3331", 254
        Indices.Add "3332", 255
        Indices.Add "3333", 256
        Indices.Add "3334", 257
        Indices.Add "3335", 258
        '
        Indices.Add "3470", 259
        Indices.Add "3471", 260
        Indices.Add "3472", 261
        Indices.Add "3473", 262
        Indices.Add "3474", 263
        Indices.Add "3475", 264
        '
        Indices.Add "3480", 265
        Indices.Add "3481", 266
        Indices.Add "3482", 267
        Indices.Add "3483", 268
        Indices.Add "3484", 269
        Indices.Add "3485", 270
        '
        Indices.Add "3490", 271
        Indices.Add "3491", 272
        Indices.Add "3492", 273
        Indices.Add "3493", 274
        Indices.Add "3494", 275
        Indices.Add "3495", 276
    'logisticAreaCode
        Indices.Add "3340", 277
        Indices.Add "3341", 278
        Indices.Add "3342", 279
        Indices.Add "3343", 280
        Indices.Add "3344", 281
        Indices.Add "3345", 282
        '
        Indices.Add "3530", 283
        Indices.Add "3531", 284
        Indices.Add "3532", 285
        Indices.Add "3533", 286
        Indices.Add "3534", 287
        Indices.Add "3535", 288
        '
        Indices.Add "3540", 289
        Indices.Add "3541", 290
        Indices.Add "3542", 291
        Indices.Add "3543", 292
        Indices.Add "3544", 293
        Indices.Add "3545", 294
        '
        Indices.Add "3550", 295
        Indices.Add "3551", 296
        Indices.Add "3552", 297
        Indices.Add "3553", 298
        Indices.Add "3554", 299
        Indices.Add "3555", 300
    'logisticVolumeCode
        Indices.Add "3350", 301
        Indices.Add "3351", 302
        Indices.Add "3352", 303
        Indices.Add "3353", 304
        Indices.Add "3354", 305
        Indices.Add "3355", 306
        '
        Indices.Add "3360", 307
        Indices.Add "3361", 308
        Indices.Add "3362", 309
        Indices.Add "3363", 310
        Indices.Add "3364", 311
        Indices.Add "3365", 312
        '
        Indices.Add "3620", 313
        Indices.Add "3621", 314
        Indices.Add "3622", 315
        Indices.Add "3623", 316
        Indices.Add "3624", 317
        Indices.Add "3625", 318
        '
        Indices.Add "3630", 319
        Indices.Add "3631", 320
        Indices.Add "3632", 321
        Indices.Add "3633", 322
        Indices.Add "3634", 323
        Indices.Add "3635", 324
        '
        Indices.Add "3670", 325
        Indices.Add "3671", 326
        Indices.Add "3672", 327
        Indices.Add "3673", 328
        Indices.Add "3674", 329
        Indices.Add "3675", 330
        '
        Indices.Add "3680", 331
        Indices.Add "3681", 332
        Indices.Add "3682", 333
        Indices.Add "3683", 334
        Indices.Add "3684", 335
        Indices.Add "3685", 336
        '
        Indices.Add "3690", 337
        Indices.Add "3691", 338
        Indices.Add "3692", 339
        Indices.Add "3693", 340
        Indices.Add "3694", 341
        Indices.Add "3695", 342
    'processorCode
        Indices.Add "7030", 343
        Indices.Add "7031", 344
        Indices.Add "7032", 345
        Indices.Add "7033", 346
        Indices.Add "7034", 347
        Indices.Add "7035", 348
        Indices.Add "7036", 349
        Indices.Add "7037", 350
        Indices.Add "7038", 351
        Indices.Add "7039", 352
    'lotCode
    '   Indices.Add "10", 353 ' => Indices "17"
    'expiryDateCode
        Indices.Add "17", 354
    'expiryTimeCode
        Indices.Add "7003", 355
    'contentCode
        Indices.Add "02", 356
    'prodDateCode
        Indices.Add "11", 357
    'dueDateCode
        Indices.Add "12", 358
    'packDateCode
        Indices.Add "13", 359
    'bestBeforeDateCode
        Indices.Add "15", 360
    'sellByDateCode
        Indices.Add "16", 361
    'firstFreezeDateCode
        Indices.Add "7006", 362
    'harvestDateCode
        Indices.Add "7007", 363
    'pricePerUnitCode
        Indices.Add "8005", 364
    'variantCode
        Indices.Add "20", 365
    'varCountCode
        Indices.Add "30", 366
    'countCode
        Indices.Add "37", 367
    'amountPayPerUnitCode
        Indices.Add "3950", 368
        Indices.Add "3951", 369
        Indices.Add "3952", 370
        Indices.Add "3953", 371
        Indices.Add "3954", 372
        Indices.Add "3955", 373
    'additionalIdCode
        Indices.Add "240", 374
    'custPartNoCode
        Indices.Add "241", 375
    'mtoVariantCode
        Indices.Add "242", 376
    'pcnCode
        Indices.Add "243", 377
    'secondarySerialCode
        Indices.Add "250", 378
    'refToSourceCode
        Indices.Add "251", 379
    'amountCode
        Indices.Add "3900", 380
        Indices.Add "3901", 381
        Indices.Add "3902", 382
        Indices.Add "3903", 383
        Indices.Add "3904", 384
        Indices.Add "3905", 385
        Indices.Add "3906", 386
        Indices.Add "3907", 387
        Indices.Add "3908", 388
        Indices.Add "3909", 389
    'amountISOCode
        Indices.Add "3910", 390
        Indices.Add "3911", 391
        Indices.Add "3912", 392
        Indices.Add "3913", 393
        Indices.Add "3914", 394
        Indices.Add "3915", 395
        Indices.Add "3916", 396
        Indices.Add "3917", 397
        Indices.Add "3918", 398
        Indices.Add "3919", 399
    'priceCode
        Indices.Add "3920", 400
        Indices.Add "3921", 401
        Indices.Add "3922", 402
        Indices.Add "3923", 403
        Indices.Add "3924", 404
        Indices.Add "3925", 405
        Indices.Add "3926", 406
        Indices.Add "3927", 407
        Indices.Add "3928", 408
        Indices.Add "3929", 409
    'priceISOCode
        Indices.Add "3930", 410
        Indices.Add "3931", 411
        Indices.Add "3932", 412
        Indices.Add "3933", 413
        Indices.Add "3934", 414
        Indices.Add "3935", 415
        Indices.Add "3936", 416
        Indices.Add "3937", 417
        Indices.Add "3938", 418
        Indices.Add "3939", 419
    'percentOffCode
        Indices.Add "3940", 420
        Indices.Add "3941", 421
        Indices.Add "3942", 422
        Indices.Add "3943", 423
    'orderNumberCode
        Indices.Add "400", 424
    'routeCode
        Indices.Add "403", 425
    'shipToLocCode
        Indices.Add "410", 426
    'billToCode
        Indices.Add "411", 427
    'purchaseFromCode
        Indices.Add "412", 428
    'shipForLocCode
        Indices.Add "413", 429
    'prodServLocCode
        Indices.Add "416", 430
    'shipToPostCode
        Indices.Add "420", 431
    'shipToPostISOCode
        Indices.Add "421", 432
    'originCode
        Indices.Add "422", 433
    'countryProcessCode
        Indices.Add "424", 434
    'countryFullProcessCode
        Indices.Add "426", 435
    'countryInitialProcessCode
        Indices.Add "423", 436
    'countryDisassemblyCode
        Indices.Add "425", 437
    'originSubdivisionCode
        Indices.Add "427", 438
    'nhrnPZNCode
        Indices.Add "710", 439
    'nhrnCIPCode
        Indices.Add "711", 440
    'nhrnCNCode
        Indices.Add "712", 441
    'nhrnDRNCode
        Indices.Add "713", 442
    'nhrnAIMCode '*
        Indices.Add "714", 443
    'nhrnUS-FDACode '*
        Indices.Add "715", 444
    'nsnCode
        Indices.Add "7001", 445
    'meatCutCode
        Indices.Add "7002", 446
    'activePotencyCode
        Indices.Add "7004", 447
    'catchAreaCode
        Indices.Add "7005", 448
    'fishingGearTypeCode
        Indices.Add "7009", 449
    'prodMethodCode
        Indices.Add "7010", 450
    'testByDateCode '*
        Indices.Add "7011", 451
    'refurbLotCode
        Indices.Add "7020", 452
    'funcStatCode
        Indices.Add "7021", 453
    'revStatCode
        Indices.Add "7022", 454
    'giaiAssemblyCode
        Indices.Add "7023", 455
    'dimensionsCode
        Indices.Add "8001", 456
    'cmtNoCode
        Indices.Add "8002", 457
    'ibanCode
        Indices.Add "8007", 458
    'prodTimeCode
        Indices.Add "8008", 459
    'versionCode
        Indices.Add "8012", 460
    'refNoCode
    '    Indices.Add "8020", 461 ' => Indices "21"
    'couponIDNACode
        Indices.Add "8110", 462
    'pointsCode
        Indices.Add "8111", 463
    'itipContentCode
        Indices.Add "8026", 464
    'certificationRefCode
        Indices.Add "7230", 465
        Indices.Add "7231", 466
        Indices.Add "7232", 467
        Indices.Add "7233", 468
        Indices.Add "7234", 469
        Indices.Add "7235", 470
        Indices.Add "7236", 471
        Indices.Add "7237", 472
        Indices.Add "7238", 473
        Indices.Add "7239", 474
    'aquaticSpeciesCode
        Indices.Add "7008", 475
    'opticalSensorCode
        Indices.Add "8009", 476
    'paperlessCouponIDNACode
        Indices.Add "8112", 477
    'internalCode
        Indices.Add "91", 478
        Indices.Add "92", 479
        Indices.Add "93", 480
        Indices.Add "94", 481
        Indices.Add "95", 482
        Indices.Add "96", 483
        Indices.Add "97", 484
        Indices.Add "98", 485
        Indices.Add "99", 486
    'mutualCode
        Indices.Add "90", 487
    'extensionKey
        Indices.Add "", 488 'AI AlphaNumérique ...
    'shipToCompCode
        Indices.Add "4300", 489
    'shipToNameCode
        Indices.Add "4301", 490
    'shipToAdd1Code
        Indices.Add "4302", 491
    'shipToAdd2Code
        Indices.Add "4303", 492
    'shipToSubCode
        Indices.Add "4304", 493
    'shipToLocalityCode
        Indices.Add "4305", 494
    'shipToRegCode
        Indices.Add "4306", 495
    'shipToCountryCode
        Indices.Add "4307", 496
    'shipToPhoneCode
        Indices.Add "4308", 497
    'shipToGeo
        Indices.Add "4309", 498
    'rtnToCompCode
        Indices.Add "4310", 499
    'rtnToNameCode
        Indices.Add "4311", 500
    'rtnToAdd1Code
        Indices.Add "4312", 501
    'rtnToAdd2Code
        Indices.Add "4313", 502
    'rtnToSubCode
        Indices.Add "4314", 503
    'rtnToLocCode
        Indices.Add "4315", 504
    'rtnToRegCode
        Indices.Add "4316", 505
    'rtnToCountryCode
        Indices.Add "4317", 506
    'rtnToPostCode
        Indices.Add "4318", 507
    'rtnToPhoneCode
        Indices.Add "4319", 508
    'srvDescriptionCode
        Indices.Add "4320", 509
    'dangerousGoodsCode
        Indices.Add "4321", 510
    'authToLeaveCode
        Indices.Add "4322", 511
    'sigRequiredCode
        Indices.Add "4323", 512
    'notBeforeDelDateCode
        Indices.Add "4324", 513
    'notAfterDelDateCode
        Indices.Add "4325", 514
    'releaseDateCode
        Indices.Add "4326", 515
    '???
    '   Indices.Add "7240", 516 '*
    '???
    '   Indices.Add "8200", 517
    '???
    '   Indices.Add "3956", 518
    '???
    '   Indices.Add "3957", 519
    '???
    '   Indices.Add "3958", 520
    '???
    '   Indices.Add "3959", 521
    
'Nouveaux AI PRJ 2027:
'* '7240, Date and time of production,PROD TIME
'7241,Optically Readable Sensor Indicator,OPTSEN
'7242,Component/Part Identifier (CPID),CPID

'4330,Functional status,FUNC STAT
'4331,Revision status,REV STAT
'4332,Global Individual Asset Identifier (GIAI) of an assembly,GIAI - ASSEMBLY
'4333,Number of processor with three-digit ISO country code,PROCESSOR # 0

End Sub

[REGEX] Recherche Patten de capture, un défi ?

142 réponses

Votre réponse

Discussions similaires