[REGEX] Recherche Patten de capture, un défi ?
Résolu
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
-
11 oct. 2023 à 20:43
Whismeril Messages postés 19044 Date d'inscription mardi 11 mars 2003 Statut Contributeur Dernière intervention 19 mai 2024 - 27 févr. 2024 à 23:34
Whismeril Messages postés 19044 Date d'inscription mardi 11 mars 2003 Statut Contributeur Dernière intervention 19 mai 2024 - 27 févr. 2024 à 23:34
A voir également:
- [REGEX] Recherche Patten de capture, un défi ?
- Java regex - Conseils pratiques -Java
- Barre de recherche php ✓ - Forum PHP
- Barre de recherche - Forum PHP
- Moteur de recherche PHP - MySQL ✓ - Forum PHP
- Php/Mysql formule de recherche Mysqli ✓ - Forum PHP
142 réponses
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
27 nov. 2023 à 23:44
27 nov. 2023 à 23:44
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
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
28 nov. 2023 à 00:15
28 nov. 2023 à 00:15
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 ?
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
28 nov. 2023 à 00:45
28 nov. 2023 à 00:45
Si tu penses qu'on peut faire tous les tests et arriver à un affichage d'information depuis les Select Case sous le format dd/mm/yyyy en partant de la date du code-bares au format yymmdd ce serait vraiment plus simple!
Exemple:
(01)00843997013703(11)210601 (01) GTIN de l’article: 00843997013703 (11) Date de production: 210601 (01) GTIN de l’article: 00843997013703, checksum OK (11) Date de production: 210601, Date Valide : 01/06/2021
Et en cas d'erreur
(01) GTIN de l’article: 00843997013703, checksum OK (11) Date de production: 210229, Date Invalide : Ce moi n'a que 28 jours!
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
28 nov. 2023 à 20:39
28 nov. 2023 à 20:39
Je suis tombé sur cette explication:
Les dates sont au format AAMMJJ.
Les valeurs AA comprises entre 51 et 99 indiquent les années 1951 à 1999.
Les valeurs AA comprises entre 00 et 50 indiquent les années 2000 à 2050.
C'est ce qui semble être utilisé dans le code C
-yymmd0
https://gs1.github.io/gs1-syntax-dictionary/lint__yymmd0_8c.html
if (YY - CURRENT_YEAR >= 51)
yyyy = 1900 + YY;
else if (YY - CURRENT_YEAR > -50)
yyyy = 2000 + YY;
else
yyyy = 2100 + YY;
De ce que je comprends l'année est aussi convertie en YYYY!
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
1 déc. 2023 à 09:11
1 déc. 2023 à 09:11
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
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
1 déc. 2023 à 11:22
1 déc. 2023 à 11:22
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?
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
1 déc. 2023 à 12:23
1 déc. 2023 à 12:23
Heu, à brule pour point, le gars peut aussi s'être planté.
Je ne suis pas bon en C, mais j'ai repéré 2 ou 3 petites boulettes dans le genre
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
1 déc. 2023 à 12:29
1 déc. 2023 à 12:29
Oui, je pense que le gars s'est planté le siècle à ajouter est dépendant aussi du siècle de l'année courante
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
Modifié le 1 déc. 2023 à 13:21
Modifié le 1 déc. 2023 à 13:21
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
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
1 déc. 2023 à 15:32
1 déc. 2023 à 15:32
On est bien d'accord que selon ce que tu as écrit plus haut, pour ton boulot on s'en fout ? Tes articles on, une durée de vie de 15 ans, donc en mettant tout au 21eme siècle, t'es tranquille jusqu'en 2085 au moins.
C'est juste le plaisir de résoudre l'énigme? Ça me va, sinon je ne serai pas encore derrière toi après 180 messages.
Mais si c'est pas le cas, il faudra mettre des gardes fou, et je ne connais pas tes contraintes pour m'en occuper.
Le code en C considère que les dates antérieures ont moins de 50 ans et les dates ultérieures ne sont pas au delà de 50 ans.
C'est donc l'année actuelle qui fait le pivot et pour tester, il faudra fausser cette condition.
Tapé de tête, sans test, sur une tablette (je suis dans les transports)
Sub test()
YY = 48
pivot = Year(Now)'forcer des valeurs pour le test
current_year = pivot Mod 100
siecle = pivot - cuurent_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
YYYY = siecle + YY
ElseIf (YY - current_year > -50) Then
YYYY = siecle + 100 + YY
End If
End Sub
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
1 déc. 2023 à 16:48
1 déc. 2023 à 16:48
Le réel travail pour le boulot et terminé depuis le message 85 où tu as résolu le problème des patterns regroupés.
Comme disent mes collègues, cela nous évite de saisir manuellement les numéros de séries, de lots les dates de garanties etc …
Ah si ! Le travail sur les URL nous aide à identifier rapidement le prestataire des dispositifs concerné !
Tout le reste est à chaque fois des petits défit pédagogique qui me font apprendre et évoluer.
Quel plaisir d'obtenir le résultat voulu.
Tu as dû remarquer que je ne suis pas du tout issu du monde de la programmation, je tente plus de résoudre les problèmes que lors du 1er message de ce poste, je comprends de mieux en mieux ce que je fais et cette sensation d'évoluer certes à mon rythme me plaît.
Je te dois beaucoup pour cela !
Je sais que tu es beaucoup moins disponible, mais toujours présent !
Merci, et j'espère pouvoir continuer à compter sur ton soutien.
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
>
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1 déc. 2023 à 19:21
1 déc. 2023 à 19:21
Je reformule.
Tu as dit que tes produits ont une durée de vie de 15 ans. Donc 2000 + yy répond au besoin de ton entreprise jusqu'en 2085 (et on peut parier que d'ici là y'aura eu du changement d'une façon ou d'une autre).
Donc trouver une date qui dépasse 2100 n'a aucun intérêt professionnel direct.
Après le jeu et l'apprentissage sont 2 très bonnes raisons.
Mais du coup, je n'ai pas le temps nécessaire à te consacrer pour ces 2 raisons. Je t'ai donné une piste, que manifestement, tu n'as pas comprise. Et, je n'ai pas pris le temps de reformuler ou de donner plus d'indices. J'ai proposé un code.
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
2 déc. 2023 à 02:29
2 déc. 2023 à 02:29
Bonjour,
J'ai répondu certainement hâtivement à ton précédent message.
Le but 1er de cette réponse était de justifier réellement ma volonté d'apprentissage et c'est dans ce sens que j'ai émis le souhait de pouvoir compté sur un soutien, le tien ou celui d'autres membres.
Je n'ai aucune contrainte de temps contrairement à toi et tu n'as aucune obligation de réponse.
Je te remercie vraiment pour le temps et de l'investissement que tu m'as accordé!
Je pense même que ce poste a très largement dépassé le sujet de départ.
J'avoue que les questions que j'ai posées et les solutions que tu as apportées étaient certainement plus facile à traiter car dans le contexte.
Je passerai ce poste en résolut après en avoir fini avec le dernier code que tu as proposé.
Donc pour revenir à ton code
Ma question sur les dates dépassant 2100 n'était pas orientée besoin, mais compréhension du code!
Je passe certainement à coté de quelque chose, mais le code que tu as donné fait la même chose que le 2éme code que j'ai donné sur le message 187 ?
Je peux forcer les valeurs en remplaçant (Now) par une année.
Code concerné:
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
Bien cordialement
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
2 déc. 2023 à 10:29
2 déc. 2023 à 10:29
Bonjour,
La nuit porte conseil!
Ce n'est pas dans ton habitude de me donner quelque chose sans un but bien précis!
Mes tentatives sur l'utilisation de ton code étant toutes en échec, je me suis dit, ce n'est pas possible il y a quelque chose!
Et là j'ai trouvé, tu as fait une erreur de saisi qui rend ton code non fonctionnel et je ne m'en étais pas aperçu.
siecle = pivot - cuurent_year
Ce n'est pas "cuurent", mais "current".
Je vais pouvoir jouer avec :)
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
2 déc. 2023 à 19:14
2 déc. 2023 à 19:14
ha oui, comme je l'ai dit, c'était tapé de tête sans vérification
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
2 déc. 2023 à 19:42
2 déc. 2023 à 19:42
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
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
2 déc. 2023 à 19:52
2 déc. 2023 à 19:52
2eme tests
Sub TestYear()
Dim i, a As Integer
For i = Year(Now) To Year(Now) + 100 Step 10
Debug.Print ("Année " & i & " en pivot")
a = i Mod 100
Debug.Print (a & " => " & SetYear(a, i + 0))
a = (i + 49) Mod 100
Debug.Print (a & " => " & SetYear(a, i + 0))
a = (i + 50) Mod 100
Debug.Print (a & " => " & SetYear(a, i + 0))
a = (i + 51) Mod 100
Debug.Print (a & " => " & SetYear(a, i + 0))
a = (i + 52) Mod 100
Debug.Print (a & " => " & SetYear(a, i + 0))
Debug.Print ("")
Next
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
Je te laisse tout regarder, mais ça merde quand le pivot est entre 2053 et 2093.
Donc faut corriger
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
2 déc. 2023 à 20:11
2 déc. 2023 à 20:11
Ce qui m'a sauté aux yeux dans les tests du message précédent, ce sont les cas ou la valeur affichée (donc, a priori, calculée par ma fonction) était 0.
J'ai donc modifié le code comme ça
'For i = Year(Now) To Year(Now) + 100 Step 10 For i = 2053 To 2054 Step 10
Mis un point d'arrêt dans SetYear, et exécuté son code en pas à pas avec des espions sur toutes les variables.
Quand y'a 0, l'exécution ne rentre dans aucun des ces if
If (YY - current_year >= 51) Then
SetYear = siecle + YY
ElseIf (YY - current_year > -50) Then
SetYear = siecle + 100 + YY
End If
Parce que c'est un else qu'il faut et pas un esleif.
Tout content, je corrige, je relance et là
Année 2053 en pivot
53 => 2153
2 => 2102
3 => 2103
4 => 2104
5 => 2105
Cool, plus de 0.
Ha mais, pourquoi j'ai 2153?
Nouvelle exécution en pas à pas et ça ne rentre pas non plus dans ce if
If current_year < 50 Then 'ou p'tet 49 ou 51 selon les piquets et les barrières
siecle = siecle - 100
End If
Et pourtant dans ma logique, ça devait le faire.... entre 49 et 51 au pire, et là avec 53 ça ne marche pas.....
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
2 déc. 2023 à 20:53
2 déc. 2023 à 20:53
Après plusieurs itérations de tests, il m'a semblé que le plus simple est de faire un calcul par défaut et si l'écart entre l'année pivot (qui sera l'année actuelle chaque année) et le résultat est en dehors de [-50 ; 50] alors, il faut corriger à coup de siècle.
Alors selon tes contraintes, ça pourrait être aussi [-49; 50] ou [-50 ; 49]. Mais [-50 ; 50], c'est plus facile à coder.
Et, comme je ne suis pas certain qu'on ne peut pas se trouver avec un cas à la con ou on a 100 ou 101 ans d'écart, je prévois qu'on puisse faire 2 corrections avec un while. Et pour ne pas en écrire 2, je teste la valeur absolue de l'écart et je fais la correction en fonction de son signe.
Sub TestYear()
Dim i, a As Integer
For i = Year(Now) To Year(Now) + 100 Step 10
'For i = 2053 To 2054 Step 10
Debug.Print ("Année " & i & " en pivot")
a = i Mod 100
'Debug.Print (a & " => " & SetYear(a, i + 0))
a = (i + 49) Mod 100
Debug.Print (a & " => " & SetYear(a, i + 0))
a = (i + 50) Mod 100
Debug.Print (a & " => " & SetYear(a, i + 0))
a = (i + 51) Mod 100
Debug.Print (a & " => " & SetYear(a, i + 0))
a = (i + 52) Mod 100
Debug.Print (a & " => " & SetYear(a, i + 0))
Debug.Print ("")
Next
End Sub
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 Abs(ecart) > 50
temp = temp - 100 * Sgn(ecart)
ecart = temp - pivot
Loop
SetYear = temp
End Function
Pour ce test, j'ai commenté la ligne de l'année pivot, j'ai validé que ça marche juste avant, et ce sera plus facile à mettre en évidence, le "soucis" de cette méthode.
Ci-dessus, les résultats qui correspondent au siècle de l'année pivot, sont commentés en vert et ceux qui correspondent à un autre siècle (en plus ou moins sont commentés en rouge.
Année 2023 en pivot 72 => 2072 'siècle en cours 73 => 2073 'siècle en cours 74 => 1974 "autre siècle" 75 => 1975 "autre siècle" Année 2033 en pivot 82 => 2082 'siècle en cours 83 => 2083 'siècle en cours 84 => 1984 "autre siècle" 85 => 1985 "autre siècle" Année 2043 en pivot 92 => 2092 'siècle en cours 93 => 2093 'siècle en cours 94 => 1994 "autre siècle" 95 => 1995 "autre siècle" Année 2053 en pivot 2 => 2102 "autre siècle" 3 => 2003 'siècle en cours 4 => 2004 'siècle en cours 5 => 2005 'siècle en cours Année 2063 en pivot 12 => 2112 "autre siècle" 13 => 2013 'siècle en cours 14 => 2014 'siècle en cours 15 => 2015 'siècle en cours Année 2073 en pivot 22 => 2122 "autre siècle" 23 => 2023 'siècle en cours 24 => 2024 'siècle en cours 25 => 2025 'siècle en cours Année 2083 en pivot 32 => 2132 "autre siècle" 33 => 2033 'siècle en cours 34 => 2034 'siècle en cours 35 => 2035 'siècle en cours Année 2093 en pivot 42 => 2142 "autre siècle" 43 => 2043 'siècle en cours 44 => 2044 'siècle en cours 45 => 2045 'siècle en cours Année 2103 en pivot 52 => 2152 'siècle en cours 53 => 2153 'siècle en cours 54 => 2054 "autre siècle" 55 => 2055 "autre siècle" Année 2113 en pivot 62 => 2162 'siècle en cours 63 => 2163 'siècle en cours 64 => 2064 "autre siècle" 65 => 2065 "autre siècle" Année 2123 en pivot 72 => 2172 'siècle en cours 73 => 2173 'siècle en cours 74 => 2074 "autre siècle" 75 => 2075 "autre siècle"
On constate qu'au début, y'a 2 verts, 2 rouges. Ensuite 1 rouge, 3 verts. Et on revient à 2 verts, 2 rouges.
Et ça c'est dû au fait que j'ai choisi, par fainéantise [-50; 50].
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
2 déc. 2023 à 20:57
2 déc. 2023 à 20:57
Si on prend [-49; 50]
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
On arrive à ça
Année 2023 en pivot 72 => 2072 'siècle en cours 73 => 2073 'siècle en cours 74 => 1974 "autre siècle" 75 => 1975 "autre siècle" Année 2033 en pivot 82 => 2082 'siècle en cours 83 => 2083 'siècle en cours 84 => 1984 "autre siècle" 85 => 1985 "autre siècle" Année 2043 en pivot 92 => 2092 'siècle en cours 93 => 2093 'siècle en cours 94 => 1994 "autre siècle" 95 => 1995 "autre siècle" Année 2053 en pivot 2 => 2102 "autre siècle" 3 => 2103 "autre siècle" 4 => 2004 'siècle en cours 5 => 2005 'siècle en cours Année 2063 en pivot 12 => 2112 "autre siècle" 13 => 2113 "autre siècle" 14 => 2014 'siècle en cours 15 => 2015 'siècle en cours Année 2073 en pivot 22 => 2122 "autre siècle" 23 => 2123 "autre siècle" 24 => 2024 'siècle en cours 25 => 2025 'siècle en cours Année 2083 en pivot 32 => 2132 "autre siècle" 33 => 2133 "autre siècle" 34 => 2034 'siècle en cours 35 => 2035 'siècle en cours Année 2093 en pivot 42 => 2142 "autre siècle" 43 => 2143 "autre siècle" 44 => 2044 'siècle en cours 45 => 2045 'siècle en cours Année 2103 en pivot 52 => 2152 'siècle en cours 53 => 2153 'siècle en cours 54 => 2054 "autre siècle" 55 => 2055 "autre siècle" Année 2113 en pivot 62 => 2162 'siècle en cours 63 => 2163 'siècle en cours 64 => 2064 "autre siècle" 65 => 2065 "autre siècle" Année 2123 en pivot 72 => 2172 'siècle en cours 73 => 2173 'siècle en cours 74 => 2074 "autre siècle" 75 => 2075 "autre siècle"
Et là, il y a toujours 2 rouges et 2 verts dans un sens ou dans l'autre.
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
7 déc. 2023 à 20:47
7 déc. 2023 à 20:47
Solution à la dernière question, comme toutes les précédents. MERCI!
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
3 déc. 2023 à 03:02
3 déc. 2023 à 03:02
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.
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
3 déc. 2023 à 09:56
3 déc. 2023 à 09:56
Les tests semblent concluants.
Comme le démontrent mes derniers messages, il faut faire suffisamment de tests pour espérer balayer tous les cas.
En l'état ton code ne le permet pas facilement
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
Modifié le 3 déc. 2023 à 14:34
Modifié le 3 déc. 2023 à 14:34
Je test le siècle entier.
On peut certainement pousser plus loin, comme passer en revue les siècles (1900, 2000 et 2100).
Je n'ai pas su gérer "pour le moment" alors je test manuellement en décommentant le siècle voulu.
Option Explicit
Function YYYY(YY As Integer, siecle As Integer) As Integer
Dim current_year As Date
current_year = Left(siecle, 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 Function
Sub TestYear()
Dim YY As Integer
Dim siecle As Integer
'siecle = Year(Now)
'siecle = "1900"
'siecle = "2000"
siecle = "2100"
Debug.Print "Test sur les années " & siecle
For YY = 0 To 99
Debug.Print (YY & " => " & YYYY(YY, siecle))
Next YY
End Sub
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
3 déc. 2023 à 14:46
3 déc. 2023 à 14:46
Pour revenir sur les tests que tu as faits précédemment, je ne vois pas comment pousser plus loin!
Si tu voulais me mettre sur une piste, je ne l'ai pas comprise.
J'ai donc travaillé en parallèle sur cette alternative.
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
4 déc. 2023 à 21:49
4 déc. 2023 à 21:49
Ma méthode n'est pas viable, ou avais-je la tête!
Siècle = Year(Now) sur une date passée, ça n'arrivera jamais.
Je n'abandonne pas, j'ai peut-être une autre idée!
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
5 déc. 2023 à 22:01
5 déc. 2023 à 22:01
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
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
6 déc. 2023 à 06:58
6 déc. 2023 à 06:58
Et bien si ça te convient, parfait
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
7 déc. 2023 à 20:42
7 déc. 2023 à 20:42
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
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
Modifié le 7 déc. 2023 à 20:58
Modifié le 7 déc. 2023 à 20:58
Solution à la dernière question "message 198", Toutes les questions de ce poste ont eu une réponse positive. MERCI @Whismeril StatutContributeur!
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
>
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
7 déc. 2023 à 21:13
7 déc. 2023 à 21:13
de rien
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
19 janv. 2024 à 14:56
19 janv. 2024 à 14:56
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?
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
19 janv. 2024 à 20:05
19 janv. 2024 à 20:05
tu peux me remettre le code complet.
Je n'ai plus accès à un 2 PCs avec lesquels j'ai jonglé pour t'aider jusqu'en mars.
Et je n'ai pas envie de me taper les 200 messages pour recoller les morceaux
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
19 janv. 2024 à 23:00
19 janv. 2024 à 23:00
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".
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
20 janv. 2024 à 21:27
20 janv. 2024 à 21:27
Tous simplement parfait, Merci.
Juste eu à déclarer "IsPriorityKeyQualifier" en public dans le module de classe unCode.
Public IsPriorityKeyQualifier As Boolean
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
21 janv. 2024 à 09:18
21 janv. 2024 à 09:18
Ha oui
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
Modifié le 21 janv. 2024 à 09:23
Modifié le 21 janv. 2024 à 09:23
A la réflexion, si on en fait un integer qui vaut 99 par défaut.
Au lieu de le mettre à True, on lui donne les valeurs d'index (0, 1 ou 2) on économise un seconde select case par la suite.
Dans GS1_Resolver, tu testes si c'est pas 99 et si c'est le cas tu appliques sa valeur dans le tableau
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
21 janv. 2024 à 20:33
21 janv. 2024 à 20:33
Là, je n'ai pas compris le principe.
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
22 janv. 2024 à 15:32
22 janv. 2024 à 15:32
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
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
22 janv. 2024 à 15:36
22 janv. 2024 à 15:36
Comment ça associer?
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
22 janv. 2024 à 16:16
22 janv. 2024 à 16:16
Faire que ces priorityKeyQualifiers soient applicable seulement aux PrimaryKeys Définis.
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
Modifié le 23 janv. 2024 à 01:12
Modifié le 23 janv. 2024 à 01:12
Je dois effectuer plusieurs vérifications avant d'aller plus loin, ne tiens pas compte de mon dernier message !
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
>
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
23 janv. 2024 à 15:35
23 janv. 2024 à 15:35
Ça me va :)
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
29 janv. 2024 à 16:32
29 janv. 2024 à 16:32
La construction des liens n'est au final pas si simple que je le pensais!
Un exemple en java qui semble gérer cette création, mais je ne comprends pas la section finale de construction!
https://github.com/evrythng/digital-link.js/blob/master/grammar/GS1_Digital_Link_Grammar_1_2.abnf
La documentation GS1 sur les liens (Chapitre 5) semble confirmer le code JAVA:
https://ref.gs1.org/standards/digital-link/
L'utilisation du module de classe unCode et le select case AI peut nous permettre de gérer les sections "Primary keys, Key qualifiers et Data attributes".
Une idée sur une éventuel adaptation ?
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
>
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
30 janv. 2024 à 18:47
30 janv. 2024 à 18:47
Je n'ai pas trop le temps de me plonger en détail dans tes docs.
Peux-tu faire un "résumé" qui reprendrait les différents cas?
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
Modifié le 5 févr. 2024 à 11:34
Modifié le 5 févr. 2024 à 11:34
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
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
5 févr. 2024 à 17:18
5 févr. 2024 à 17:18
Je n'ai pas eu le temps de m'y pencher ces derniers jours.
Je devais pouvoir trouver un moment cette semaine
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
>
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
6 févr. 2024 à 08:33
6 févr. 2024 à 08:33
Merci, si besoin de compléments d'informations, n'hésite pas!
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
7 févr. 2024 à 23:17
7 févr. 2024 à 23:17
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
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
8 févr. 2024 à 13:34
8 févr. 2024 à 13:34
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
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
8 févr. 2024 à 19:50
8 févr. 2024 à 19:50
Un lien vers le projet complet (fichier zip) si cela peut aider:
Je ne vois pas où je fais fausse route!
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
Modifié le 12 févr. 2024 à 16:11
Modifié le 12 févr. 2024 à 16:11
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
NeriXs
Messages postés
258
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
27 février 2024
1
12 févr. 2024 à 23:31
12 févr. 2024 à 23:31
J'ai vraiment du mal à me projeter avec tous les AIs dans un même tableau.
Comment vais-je différencier les PrimaryKeys, KeyQualifiers et les DataAttributes ?
Un petit test pour illustrer ma compréhension de ta proposition:
Sub test()
Dim AI As Variant
Dim priorityKeyQualifier As Variant
Dim Resultat As String
AI = Array("22", "10", "21")
ReDim priorityKeyQualifier(LBound(AI) To UBound(AI)) 'on redefinit priorityKeyQualifier comme étant un tableau de même dimension que AI
For i = LBound(AI) To UBound(AI)
Select Case AI(i)
Case "22"
Index = 0
Case "10"
Index = 1
Case Else
Index = 2
End Select
priorityKeyQualifier(Index) = AI(i)
Next i
Resultat = Join(priorityKeyQualifier, "/")
MsgBox Resultat
End Sub
Dans ce cas il me faut 3 tableaux!
Le travail fait avec l'AI 8011 sera perdu.
Je me sens comme poule avec une paire de ciseaux!
Whismeril
Messages postés
19044
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
19 mai 2024
656
13 févr. 2024 à 23:59
13 févr. 2024 à 23:59
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....