IMPRIMIR CÓDIGO V?RIOS DE BARRAS DE UMA VEZ

RDPISA 30/08/2017 00:10:57
#476094
Olá amigos alguém poderia me ajudar, tenho um projeto que gera códigos de barras , mas só que na hora de imprimir,
vai um de cada vez, um em cada folha gostaria de encher a fola com vários códigos como que faço.

Aqui todo o Código...
[txt-color=#e80000]
Dim pic As PictureBox
Dim zz1 As Variant
Dim zz2 As Variant





Private Sub CmdUnico_Click()
GeraCodBar39 txtData, 20
End Sub

Private Sub Form_Load()
Set pic = picBarCode
zz1 = Split([Ô]0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,-,.,SP,$,/,+,%,*[Ô], [Ô],[Ô])
zz2 = Split([Ô]111221211,211211112,112211112,212211111,111221112,211221111,112221111,111211212,211211211,112211211,211112112,112112112,212112111,111122112,211122111,112122111,111112212,211112211,112112211,111122211,211111122,112111122,212111121,111121122,211121121,112121121,111111222,211111221,112111221,111121221,221111112,122111112,222111111,121121112,221121111,122121111,121111212,221111211,122111211,121212111,121211121,121112121,111212121,121121211[Ô], [Ô],[Ô])
GeraCodBar39 txtData, 20
End Sub

Private Sub GeraCodBar39(X As String, Sclr As Integer)
Dim bc4(0 To 20) As String
Dim barchar As String
Dim barcolor As String
Dim bs As Single
Dim bwn As Single
Dim ac As Integer
Dim s As Integer
Dim bct As Integer
Dim bcl As Integer
ac = 1
pic.Cls
bc4(ac - 1) = [Ô]121121211[Ô]
For bct = 1 To Len(X)
barchar = Mid(X, bct, 1)
If barchar = [Ô] [Ô] Then barchar = [Ô]SP[Ô]
For s = 0 To UBound(zz1)
If UCase(barchar) = zz1(s) Then
bc4(ac) = zz2(s)
ac = ac + 1
Exit For
End If
Next s
Next bct
bc4(ac) = [Ô]121121211[Ô]
bs = 200
pic.DrawWidth = 1
For bct = 0 To ac
X = bc4(bct)
barcolor = vbBlack
For s = 1 To Len(X)
bwn = (Val(Mid(X, s, 1))) * Sclr
For bcl = 1 To bwn
pic.Line (bs + bcl, 100)-Step(0, 1200), barcolor
Next bcl
If barcolor = vbBlack Then barcolor = vbWhite Else barcolor = vbBlack
bs = bs + bwn
Next s
For bcl = 1 To Sclr
pic.Line (bs + bcl, 100)-Step(0, 1200), vbWhite
Next bcl
bs = bs + bcl
Next bct
pic.FontSize = 16: pic.CurrentX = 200: pic.CurrentY = 1400: pic.Print UCase(txtData)
End Sub
Private Sub cmdPrint_Click()
Dim bc4(0 To 20) As String
Dim barchar As String
Dim barcolor As Boolean
Dim X As String
Dim Sclr As Single
Dim bs As Single
Dim bwn As Single
Dim ac As Integer
Dim s As Integer
Dim bct As Integer
Dim bcl As Integer
ac = 1
Sclr = 20
X = txtData
bc4(ac - 1) = [Ô]121121211[Ô]
For bct = 1 To Len(X)
barchar = Mid(X, bct, 1)
If barchar = [Ô] [Ô] Then barchar = [Ô]SP[Ô]
For s = 0 To UBound(zz1)
If UCase(barchar) = zz1(s) Then
bc4(ac) = zz2(s)
ac = ac + 1
Exit For
End If
Next s
Next bct
bc4(ac) = [Ô]121121211[Ô]
bs = 400
For bct = 0 To ac
X = bc4(bct)
barcolor = True
For s = 1 To Len(X)
bwn = (Val(Mid(X, s, 1))) * Sclr
If barcolor = True Then Printer.Line (bs, 100)-Step(bwn, 1200), vbBlack, BF
barcolor = IIf(barcolor = True, False, True)
bs = bs + bwn
Next s
bs = bs + Sclr
Next bct
Printer.FontSize = 16: Printer.CurrentX = 400: Printer.CurrentY = 1400: Printer.Print UCase(txtData)
Printer.EndDoc

End Sub

Private Sub txtData_Change()
cmdPrint.Enabled = True
End Sub[/txt-color]
LUIS2014 30/08/2017 09:41:46
#476101 Resposta escolhida
Bom dia,
esse código pelo visto você pegou pronto.
chegou a entender o que ele faz? Da uma boa olhada linha por linha nele que você já acha o que precisa mudar.
Tópico encerrado , respostas não são mais permitidas
Voltar