Code barre gratuit sous access 97 [Sources]

**massol joel** · 26/10/2006, 18h23

Bonjour,

Pour les gens que cela interresse je vous joint une petite base sous 97 qui vous montre comment générer gratuitement un code barre... bien pratique quand on veut pas payer un control ActiveX cher et compliqué à manipuler.

Bon développement à vous tous...

**massol joel** · 26/10/2006, 19h18

Pour ceux que cela interresse voici le code de fonction permettant d'afficher les codes barres à partir d'un champ numérique d'une table, extrait de cette base donnée sous access 97 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
Option Compare Database   'Use database order for string comparisons
Option Explicit
'
' barcode39.mdb
'
' Barcode Generator for Code 3 of 9, Code 39, and Mil-spec Logmars.
'
' version 2.0 (updated for MsAccess 97)
'
' (c) 1993-1999 James Isle Mercanti, Cocoa Beach, FL 32931  USA
' Permission granted for public use and royalty-free distribution.
' No mention of source or credits is required. All rights reserved.
'
' TO USE THIS CODE:
'
'   1 - Create Report with a TextBox control. (example named Barcode)
'       Make sure the Visible property is set to "No".
'   2 - Set On-Print property of section to [Event Procedure]
'       by clicking on the [...] and selecting "Code Builder"
'   3 - Confirm that the following code matches yours...
'
'      Sub Detail1_Print (Cancel As Integer, PrintCount As Integer)
'
'         Result = MD_Barcode39(Barcode, Me)
'
'      End Sub
'
'   4 - NOTE: The name of the section is "Detail1" for example only!
'       Your section might show a different name. Ditto for "Barcode".
'
'   5 - NOTE: To use on sub-forms, the Report name should be hard-coded
'       into the function. i.e. Rpt = Reports!MainForm!SubForm.Report.
'       The easy method is to just avoid using sub-forms and sub-reports.
'
 
Function MD_Barcode39(Ctrl As Control, Rpt As Report)
 
    On Error GoTo ErrorTrap_BarCode39
 
    Dim Nbar As Single, Wbar As Single, Qbar As Single, NextBar As Single
    Dim CountX As Single, CountY As Single, CountR As Single
    Dim Parts As Single, Pix As Single, Color As Long, BarCodePlus As Variant
    Dim Stripes As String, BarType As String, Barcode As String
    Dim Mx As Single, my As Single, Sx As Single, Sy As Single
    Const White = 16777215: Const Black = 0
    Const Nratio = 20, Wratio = 55, Qratio = 35
 
    'Get control size and location properties.
    Sx = Ctrl.Left: Sy = Ctrl.Top: Mx = Ctrl.Width: my = Ctrl.Height
 
    'Set handle on control.
    Barcode = Ctrl
 
    'Calculate actual and relative pixels values.
    Parts = (Len(Barcode) + 2) * ((6 * Nratio) + (3 * Wratio) + (1 * Qratio))
    Pix = (Mx / Parts):
    Nbar = (20 * Pix): Wbar = (55 * Pix): Qbar = (35 * Pix)
 
    'Initialize bar index and color.
    NextBar = Sx
    Color = White
 
    'Pad each end of string with start/stop characters.
    BarCodePlus = "*" & UCase(Barcode) & "*"
 
    'Walk through each character of the barcode contents.
    For CountX = 1 To Len(BarCodePlus)
 
        'Get Barcode 1/0 string for indexed character.
        Stripes = MD_BC39(Mid$(BarCodePlus, CountX, 1))
        For CountY = 1 To 9
 
            'For each 1/0, draw a wide/narrow bar.
            BarType = Mid$(Stripes, CountY, 1)
 
            'Toggle the color (black/white).
            If Color = White Then Color = Black Else Color = White
            Select Case BarType
 
                Case "1"
                    'Draw a wide bar.
                    Rpt.Line (NextBar, Sy)-Step(Wbar, my), Color, BF
                    NextBar = NextBar + Wbar
 
                Case "0"
                    'Draw a narrow bar.
                    Rpt.Line (NextBar, Sy)-Step(Nbar, my), Color, BF
                    NextBar = NextBar + Nbar
 
            End Select
        Next CountY
 
        'Toggle the color (black/white).
        If Color = White Then Color = Black Else Color = White
 
        'Draw intermediate "quiet" bar.
        Rpt.Line (NextBar, Sy)-Step(Qbar, my), Color, BF
        NextBar = NextBar + Qbar
 
    Next CountX
 
Exit_BarCode39:
    Exit Function
 
ErrorTrap_BarCode39:
    Resume Exit_BarCode39
 
End Function
 
Function MD_BC39(CharCode As String) As String
 
    On Error GoTo ErrorTrap_BC39
 
    ReDim BC39(90)
 
    BC39(32) = "011000100" ' space
    BC39(36) = "010101000" ' $
    BC39(37) = "000101010" ' %
    BC39(42) = "010010100" ' * Start/Stop
    BC39(43) = "010001010" ' +
    BC39(45) = "010000101" ' |
    BC39(46) = "110000100" ' .
    BC39(47) = "010100010" ' /
    BC39(48) = "000110100" ' 0
    BC39(49) = "100100001" ' 1
    BC39(50) = "001100001" ' 2
    BC39(51) = "101100000" ' 3
    BC39(52) = "000110001" ' 4
    BC39(53) = "100110000" ' 5
    BC39(54) = "001110000" ' 6
    BC39(55) = "000100101" ' 7
    BC39(56) = "100100100" ' 8
    BC39(57) = "001100100" ' 9
    BC39(65) = "100001001" ' A
    BC39(66) = "001001001" ' B
    BC39(67) = "101001000" ' C
    BC39(68) = "000011001" ' D
    BC39(69) = "100011000" ' E
    BC39(70) = "001011000" ' F
    BC39(71) = "000001101" ' G
    BC39(72) = "100001100" ' H
    BC39(73) = "001001100" ' I
    BC39(74) = "000011100" ' J
    BC39(75) = "100000011" ' K
    BC39(76) = "001000011" ' L
    BC39(77) = "101000010" ' M
    BC39(78) = "000010011" ' N
    BC39(79) = "100010010" ' O
    BC39(80) = "001010010" ' P
    BC39(81) = "000000111" ' Q
    BC39(82) = "100000110" ' R
    BC39(83) = "001000110" ' S
    BC39(84) = "000010110" ' T
    BC39(85) = "110000001" ' U
    BC39(86) = "011000001" ' V
    BC39(87) = "111000000" ' W
    BC39(88) = "010010001" ' X
    BC39(89) = "110010000" ' Y
    BC39(90) = "011010000" ' Z
 
    MD_BC39 = BC39(Asc(CharCode))
 
Exit_BC39:
    Exit Function
 
ErrorTrap_BC39:
    MD_BC39 = ""
    Resume Exit_BC39
 
End Function

Au niveau de l'état il fait appel au code évènement "sur impression" avec le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Option Compare Database   'Use database order for string comparisons
 
Private Sub Detail1_Print(Cancel As Integer, PrintCount As Integer)
 
    Result = MD_Barcode39(Barcode, Me)
 
End Sub

Je trouve ce code génial, il évite les control activeX payants ou l'utilisation de polices spéciales également payantes...

**qualiacier** · 26/01/2007, 14h04

je dois justement tester les codes barres sous 97 ^^

jamais travailler sur les codes barres alors je me documente et test en meme tps

jte donnerai mes impressions

merci

Invité · 29/01/2007, 10h21

Salut

Pas mal du tout, as-tu testé avec différents lecteurs de code barre pour savoir si tu avais une bonne lecture.

Starec

**jacou** · 22/12/2007, 13h39

Je pense que ce programme génère de faux code barre, car comparé aux paquets de produits imprimés par fabricant en EAN13, ça ne correspond presque jamais. Détrompez-moi si vous pouvez...

**alaingui** · 17/01/2008, 12h54

Envoyé par jacou

Je pense que ce programme génère de faux code barre, car comparé aux paquets de produits imprimés par fabricant en EAN13, ça ne correspond presque jamais. Détrompez-moi si vous pouvez...

ben oui puisqu'il s'agit de CODE39