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

 Tópico anterior Próximo tópico Novo tópico

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

VB / VBA

 Compartilhe  Compartilhe  Compartilhe
#476094 - 30/08/2017 00:10:57

RDPISA
CATANDUVA
Cadast. em:Junho/2017


Última edição em 30/08/2017 00:29:06 por RDPISA

 Anexos estao visíveis somente para usuários registrados

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...

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



Rogério De Pinto

#476101 - 30/08/2017 09:41:46

LUIS2014
CURITIBA
Cadast. em:Agosto/2014


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 anterior Próximo tópico Novo tópico


Para responder este tópico o login é requerido
Se você já possui uma conta de usuário por favor faça seu login
Se você não possui uma conta de usuário use a opção Criar usuário