1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
| Public Function MakeBarCode(ByVal DataToBarCode As String)
Dim mini, i, dummy As Short
Dim checksum As Integer
Dim tableB As Boolean
MakeBarCode = ""
If Len(DataToBarCode) > 0 Then
'Vérifier si caractères valides
For i = 1 To Len(DataToBarCode)
Select Case Asc(Mid(DataToBarCode, i, 1))
Case 32 To 126
Case Else
i = 0
Exit For
End Select
Next
'Calculer la chaine de code en optimisant l'usage des tables B et C
MakeBarCode = ""
tableB = True
If i > 0 Then
i = 1 'i% devient l'index sur la DataToBarCode
Do While i <= Len(DataToBarCode)
If tableB Then
'Voir si intéressant de passer en table C
'Oui pour 4 chiffres au début ou à la fin, sinon pour 6 chiffres
mini = IIf(i = 1 Or i + 3 = Len(DataToBarCode), 4, 6)
mini = mini - 1
If i + mini <= Len(DataToBarCode) Then
Do While mini >= 0
If Asc(Mid(DataToBarCode, i + mini, 1)) < 48 Or Asc(Mid(DataToBarCode, i + mini, 1)) > 57 Then Exit Do
mini = mini - 1
Loop
End If
If mini < 0 Then 'Choix table C
If i = 1 Then 'Débuter sur table C
MakeBarCode = Chr(205)
Else 'Commuter sur table C
MakeBarCode = MakeBarCode & Chr(199)
End If
tableB = False
Else
If i = 1 Then MakeBarCode = Chr(204) 'Débuter sur table B
End If
End If
If Not tableB Then
'On est sur la table C, essayer de traiter 2 chiffres
mini = 2
mini = mini - 1
If i + mini <= Len(DataToBarCode) Then
Do While mini >= 0
If Asc(Mid(DataToBarCode, i + mini, 1)) < 48 Or Asc(Mid(DataToBarCode, i + mini, 1)) > 57 Then Exit Do
mini = mini - 1
Loop
End If
If mini < 0 Then 'OK pour 2 chiffres, les traiter
dummy = Val(Mid(DataToBarCode, i, 2))
dummy = IIf(dummy < 95, dummy + 32, dummy + 100)
MakeBarCode = MakeBarCode & Chr(dummy)
i = i + 2
Else 'On n'a pas 2 chiffres, repasser en table B
MakeBarCode = MakeBarCode & Chr(200)
tableB = True
End If
End If
If tableB Then
'Traiter 1 caractère en table B
MakeBarCode = MakeBarCode & Mid(DataToBarCode, i, 1)
i = i + 1
End If
Loop
'Calcul de la clé de contrôle
For i = 1 To Len(MakeBarCode)
dummy = Asc(Mid(MakeBarCode, i, 1))
dummy = IIf(dummy < 127, dummy - 32, dummy - 100)
If i = 1 Then checksum = dummy
checksum = (checksum + (i - 1) * dummy) Mod 103
Next
'Calcul du code ASCII de la clé
checksum = IIf(checksum < 95, checksum + 32, checksum + 100)
'Ajout de la clé et du STOP
MakeBarCode = MakeBarCode & Chr(checksum) & Chr(206)
End If
End If
End Function |
