Bonjour à tous,

Je vous sollicite aujourd'hui car j'ai un problème avec l'impression de codes barres. J'ai une macro (pas réalisée par moi-même) qui s'occupe de récupérer des informations d'une feuille Excel (numéro d'enregistrement, nom du produit et emplacement). Le but étant d'imprimer ces informations sur une étiquette. Sur cette étiquette il y a le numéro d'enregistrement, le code barre correspondant et le nom du produit.

Le problème est le suivant :

Mon code barre s'imprime sur 2 lignes différentes (une première partie en haut et la seconde partie en bas, pas 2 exemplaires sur 2 lignes), il est donc illisible,. J'ai essayé de changer la taille de police, et même de police en soit, mais rien n'y fait.

Je joins le code où je n'ai essayé jusque là que de modifier la dernière partie qui s'occupe de l'impression (sub printout), et une photo exemple de l'étiquette. Etant complètement novice, je ne comprends pas vraiment le but de chaque élément du code, même avec les commentaires.

(Les tâches sur la photo n'ont pas d'incidence, j'ai essayé sur une autre imprimante où l'impression est parfaite et cela ne change rien).

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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
Dim defaultprinter
 
Sub auto_open()
 
strComputer = "."
Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")
 
For Each objprinter In colPrinters
    If objprinter.Default = True Then
defaultprinter = objprinter.Name
      MsgBox (defaultprinter)
        Exit For
    End If
Next
 
 
End Sub
 
Sub Srlnbrprint()
' delcaration variables calcul cell
 
Dim row As String
 
Dim itemcell As String
Dim itemdesccell As String
Dim labelprintqtycell As String
 
Dim Item As String
Dim itemdesc As String
 
Dim answer As Integer
 
Dim labelprintqty As String
 
'declarations generation userform
 
    Dim TempForm As Object
    Dim NewButton As MSForms.CommandButton
    Dim NewLabel As MSForms.Label
    Dim NewTextBox As MSForms.TextBox
    Dim NewOptionButton As MSForms.OptionButton
    Dim NewCheckBox As MSForms.CheckBox
    Dim X As Integer
    Dim Line As Integer
    Dim MyScript As String
    Dim myresult As String
 
    Dim Mycellvalue As String
    Dim myquote As String
    Dim s As String
    Dim intlinecount As Integer
 
     Dim nbrlabels As Integer
     Dim cella As String
     Dim cellb As String
     Dim cellc As String
     Dim celld As String
 
'calcule cellule
 
 
row = ActiveCell.row
 
itemcell = "B" & row
itemdesccell = "C" & row
labelprintqtycell = "A" & row
 
' recherche ligne
 
Item = Range(itemcell).Value
itemdesc = Range(itemdesccell).Value
labelprintqty = Range(labelprintqtycell).Value
 
 answer = MsgBox("Print" & labelprinqty & "Labels for Item : " & Item & "  /  " & itemdesc, vbYesNo + vbQuestion, "mDF XLpages.com")
    If answer = vbYes Then
 
 
 
   'generation user form
 
 
    'This is to stop screen flashing while creating form
    Application.VBE.MainWindow.Visible = False
 
 
    Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
 
    'Create the User Form
    With TempForm
        .Properties("Caption") = "My User Form"
        .Properties("Width") = 450
        .Properties("Height") = 1000
        .Properties("BackColor") = RGB(100, 161, 218)
    End With
    'Create  Labels
 'Item + designation
        Set NewLabel = TempForm.designer.Controls.Add("Forms.label.1")
        With NewLabel
            .Name = "Itemnumberlabel"
            .Caption = "Item : " + Item
            .Top = 10
            .Left = 2
            .Width = 120
            .Height = 16
            .Font.Size = 12
            .Font.Name = "Tahoma"
            .BackColor = RGB(100, 161, 218)
            End With
 
 Set NewLabel = TempForm.designer.Controls.Add("Forms.label.1")
        With NewLabel
            .Name = "Itemdesclabel"
            .Caption = " " + itemdesc
            .Top = 10
            .Left = 125
            .Width = 400
            .Height = 16
            .Font.Size = 12
            .Font.Name = "Tahoma"
            .BackColor = RGB(100, 161, 218)
            End With
 
            'OK cancel button
        Set NewButton = TempForm.designer.Controls.Add("Forms.commandbutton.1")
        With NewButton
            .Name = "ok"
            .Caption = "  OK  "
            .Top = 25
            .Left = 350
            .AutoSize = True
             End With
 
             'Check Box
    '(True -> Upper Case of Text Box Value;False -> Lower Case of Text Box Value)
 
        With TempForm.codemodule
 
            intlinecount = .countoflines
 
            intlinecount = intlinecount + 1
 
           .insertlines intlinecount, "Sub OK_Click()"
 
          For X = 0 To (labelprintqty - 1)
 
           MyScript = "result_Text" & X + 1 & " = ucase(mytextbox" & X + 1 & ")"
 
           intlinecount = intlinecount + 1
            .insertlines intlinecount, MyScript
 
           intlinecount = intlinecount + 1
 
 
            Next
 
        intlinecount = intlinecount + 1
    .insertlines intlinecount, "End Sub"
        End With
 
 
 
 
 
             Set NewButton = TempForm.designer.Controls.Add("Forms.commandbutton.1")
        With NewButton
            .Name = "Cancel"
            .Caption = " Cancel "
            .Top = 25
            .Left = 390
            .AutoSize = True
             End With
             'Add event-hander subs for the CommandButtons
    With TempForm.codemodule
    intlinecount = .countoflines
    .insertlines intlinecount + 1, "Private Sub Cancel_Click()"
    .insertlines intlinecount + 2, ""
    .insertlines intlinecount + 3, "unload me"
    .insertlines intlinecount + 4, ""
    .insertlines intlinecount + 5, "End Sub"
 
End With
 
             'bouton imprimer
 
             Set NewButton = TempForm.designer.Controls.Add("Forms.commandbutton.1")
        With NewButton
            .Name = "Print"
            .Caption = " Print"
            .Top = 25
            .Left = 300
            .AutoSize = True
             End With
             'Add event-hander subs for the CommandButtons
    With TempForm.codemodule
 
    intlinecount = .countoflines
 
           intlinecount = intlinecount + 1
 
           .insertlines intlinecount, "Private Sub Print_Click()"
           intlinecount = intlinecount + 1
           .insertlines intlinecount, "Worksheets.Add().Name =" & """serialnumbers"""
 
          For X = 1 To (labelprintqty)
 
          'A= Item
          myquote = """"
           Mycellvalue = myquote & Item & myquote
           MyScript = "Worksheets(" & """serialnumbers""" & ").Range(" & """" & "A" & X & """" & ").Value =" & Mycellvalue
           intlinecount = intlinecount + 1
           .insertlines intlinecount, MyScript
           'B=description
           Mycellvalue = myquote & itemdesc & myquote
           MyScript = "Worksheets(" & """serialnumbers""" & ").Range(" & """" & "B" & X & """" & ").Value =" & Mycellvalue
           intlinecount = intlinecount + 1
           .insertlines intlinecount, MyScript
 
           'C= serial number
           Mycellvalue = "Result_Text" & X
 
 
           MyScript = "Worksheets(" & """serialnumbers""" & ").Range(" & """" & "C" & X & """" & ").Value =" & Mycellvalue
           intlinecount = intlinecount + 1
           .insertlines intlinecount, MyScript
 
           'D= num piece
           Mycellvalue = X
 
           MyScript = "Worksheets(" & """serialnumbers""" & ").Range(" & """" & "D" & X & """" & ").Value =" & Mycellvalue
           intlinecount = intlinecount + 1
           .insertlines intlinecount, MyScript
 
           'E= nbr totalpieces
           Mycellvalue = labelprintqty
 
           MyScript = "Worksheets(" & """serialnumbers""" & ").Range(" & """" & "E" & X & """" & ").Value =" & Mycellvalue
           intlinecount = intlinecount + 1
           .insertlines intlinecount, MyScript
 
            Next
    intlinecount = intlinecount + 1
    .insertlines intlinecount, "Application.Run" & "(" & """Printout""" & ")"
    '
    intlinecount = intlinecount + 1
    .insertlines intlinecount, "End Sub"
 
 
 
End With
 
 
 
    'Create  Labels
    For X = 0 To (labelprintqty - 1)
        Set NewLabel = TempForm.designer.Controls.Add("Forms.label.1")
        With NewLabel
            .Name = "FieldLabel" & X + 1
            .Caption = X + 1
            .Top = 50 + (30 * X)
            .Left = 5
            .Width = 20
            .Height = 20
            .Font.Size = 14
            .Font.Name = "Tahoma"
            .BackColor = RGB(100, 161, 218)
        End With
    Next
 
    'Create Text Boxes
    For X = 0 To (labelprintqty - 1)
        Set NewTextBox = TempForm.designer.Controls.Add("Forms.textbox.1")
        With NewTextBox
            .Name = "MyTextBox" & X + 1
            .Top = 50 + (30 * X)
            .Left = 20
            .Width = 200
            .Height = 20
            .Font.Size = 12
            .Font.Name = "Tahoma"
            .BorderStyle = fmBorderStyleSingle
            .SpecialEffect = fmSpecialEffectFlat
        End With
    Next
 
    'creation des champs calculés
 
    For X = 0 To (labelprintqty - 1)
        Set NewLabel = TempForm.designer.Controls.Add("Forms.label.1")
        With NewLabel
            .Name = "Result_Text" & X + 1
            .Caption = ""
            .Top = 50 + (30 * X)
            .Left = 230
            .Width = 200
            .Height = 20
            .Font.Size = 12
            .Font.Name = "Tahoma"
            .BorderStyle = fmBorderStyleSingle
            .BackColor = RGB(100, 161, 218)
        End With
Next
 
'Boutin print non visibel si pas fait OK
 
 
    'Show the form
    VBA.UserForms.Add(TempForm.Name).Show
 
    'Delete the form (Optional)
  ThisWorkbook.VBProject.VBComponents.Remove TempForm
 
 
    Else
 
        ' ...
    End If
 
End Sub
 
 
 
 
 
Sub Printout()
 
 
Dim net
Set net = CreateObject("WScript.Network")
'net.SetDefaultPrinter "\\crpsfrprt001\crppfrpr0015"
 
 'Application.Dialogs(xlDialogPrinterSetup).Show
 
 nbrlabels = CStr(ThisWorkbook.Sheets("Serialnumbers").Range("E1").Value)
 
 
 
 For X = 0 To nbrlabels - 1
cella = "A" & (X + 1)
cellb = "B" & (X + 1)
cellc = "C" & (X + 1)
celld = "D" & (X + 1)
 
 
 
prt.prtitem = CStr(ThisWorkbook.Sheets("Serialnumbers").Range(cella).Value) & Chr(10) & CStr(ThisWorkbook.Sheets("Serialnumbers").Range(cellb).Value)
prt.prtsrlnbr.Font.Name = "Libre Barcode 39 Extended Text"
prt.prtsrlnbr.Font.Size = 25
prt.prtsrlnbr = "*" & CStr(ThisWorkbook.Sheets("Serialnumbers").Range(cella).Value) & "*"
prt.prtsrlnbr1 = CStr(ThisWorkbook.Sheets("Serialnumbers").Range(cellc).Value)
 
prt.Printform
'Prt.Show
Next
 
Application.DisplayAlerts = False
 
Worksheets("serialnumbers").Delete
 Application.DisplayAlerts = True
 
 'Set net = CreateObject("WScript.Network")
'net.SetDefaultPrinter defaultprinter
 
 
End Sub