CODIGO DE BARRAS

DIONISIO 18/10/2015 11:08:16
#452664
bOM DIA A TODOS, ESTOU COM PROBLEMA ALGUEM PODE ME AJUDAR, COM ESTE CODIGO ABAIXO E GERO CODIGO DE BARRAS DE BOLETO BANCARIO EM UM RELATORIO DO ACCESS, MAS ESTOU QUERENDO MUDAR PARA UM DATAREPORT DO VB6.0 DE QUE FORMA EU POSSO USAR ESTE CODIGO ABAIXO DENTRO DO CODIGO DO DATAREPORT? ALGUEM PODE ME AJUDAR?



Function barcode(anycode)
Dim db As Database, tbllookup As Recordset

Dim nbar, wbar, ibar, startx, starty, depth, newposn As Single
Dim numero As Integer
Dim countx, countz, countr As Single
Dim getstr, exstr As String
Dim scanstr, onechr, num_scanstr As String
Dim colour As Long
Dim rpt As Report

Set db = CurrentDb()
Set rpt = Reports![boleto_Itau_C71]
[ô][ô]Stop
DoCmd.Maximize

startx = 270 [ô][ô] Coordena o Codigo na HORIZONTAL(deitado)
starty = 15180 [ô][ô] Coordena o Codigo na VERTICAL(em pe) ate 15000(para A4)
nbar = 17 [ô][ô] 14 [ô][ô] Dimensao das Barras
wbar = 41 [ô][ô] 30 [ô][ô] Largura da Barra Grossa
ibar = 35 [ô][ô] 20 [ô][ô] Largura da Barra Fina
depth = 700 [ô][ô] 450 [ô][ô] Altura da Barra
newposn = startx [ô][ô] Posiciona as Barras
colour = 16777215 [ô][ô] Define a Cor para Iniciar(esta e Branca)

Set tbllookup = db.OpenRecordset([Ô]tab_risco[Ô])
getstr = anycode
extstr = getstr

tbllookup.index = [Ô]character[Ô]
numero = 1

[ô][ô]------Aqui e Delimitador do Inicio do Codigo de Barras--------------------------
colour = 0
rpt.Line (newposn, starty)-Step(nbar, depth), colour, BF
newposn = newposn + nbar

colour = 16777215
rpt.Line (newposn, starty)-Step(nbar, depth), colour, BF
newposn = newposn + nbar

colour = 0
rpt.Line (newposn, starty)-Step(nbar, depth), colour, BF
newposn = newposn + nbar

colour = 16777215
rpt.Line (newposn, starty)-Step(nbar, depth), colour, BF
newposn = newposn + nbar
[ô][ô]------Aqui e o Final do Delimitador do Inicio do Codigo de Barras---------------


[ô][ô]------Aqui Inicia o Loop para divisao dos 44 caracteres em sequencia de 2 de 5 Intercalado
[ô][ô]------e busca a representação grafica na tabela (tab_risco)
For countx = 1 To (Len(extstr) / 2)
tbllookup.Seek [Ô]=[Ô], Mid$(extstr, numero, 2)

numero = numero + 2
If tbllookup.nomatch Then
[ô][ô] --Se a (tab_risco) estiver vazia, sa esta mensagem, mas mesmo assim continua

MsgBox ([Ô]Campo contem caracter não suportado por 2 de 5[Ô])
rpt.Line (startx, starty)-Step(depth, depth), 155, BF

Else
num_scanstr = tbllookup![character]
scanstr = tbllookup![pattern]
For countz = 1 To 10
onechr = Mid$(scanstr, countz, 1)
If colour = 16777215 Then [ô][ô]-- Esta cor e Branca
colour = 0 [ô][ô]-- Esta cor e Preta
Else
colour = 16777215
End If

Select Case onechr [ô][ô]-- Aqui Monta os Riscos
Case [Ô]L[Ô] [ô][ô]-- Este e o Risco Grosso

rpt.Line (newposn, starty)-Step(wbar, depth), colour, BF
newposn = newposn + wbar

Case [Ô]S[Ô] [ô][ô]-- Este e o Risco Fino

rpt.Line (newposn, starty)-Step(nbar, depth), colour, BF
newposn = newposn + nbar

Case Else [ô][ô]-- Aqui sai se a Tabela que representa os riscos fino/grosso
[ô][ô]-- estiver errado -- L/S

MsgBox [Ô]Erro@[Ô] & [Ô]@- Um código incorreto foi digitado na Tabela 'Barra'[Ô] & Chr(13) & Chr(13) _
& [Ô]- Verifique se o campo Pattern nao foi alterado[Ô], vbCritical
rpt.Line (startx, starty)-Step(depth, depth), 8388608, BF
End Select
Next countz
End If
Next countx

[ô][ô]------Aqui e Delimitador do Final do Codigo de Barras--------------------------
colour = 16777215
newposn = newposn - nbar
rpt.Line (newposn, starty)-Step(nbar, depth), colour, BF
newposn = newposn + nbar

colour = 0
rpt.Line (newposn, starty)-Step(wbar, depth), colour, BF
newposn = newposn + wbar

colour = 16777215
rpt.Line (newposn, starty)-Step(nbar, depth), colour, BF
newposn = newposn + nbar

colour = 0
rpt.Line (newposn, starty)-Step(nbar, depth), colour, BF
newposn = newposn + nbar

tbllookup.Close

End Function
JORGESALES 18/10/2015 12:20:39
#452670 Resposta escolhida
Amigo, neste site tem algo que faz exatamente o que você está querendo:
http://cursoexcelvba.com.br/produto/Gerar-Codigo-de-Barras---K-Lux-Curso-de-Excel/70/
Tópico encerrado , respostas não são mais permitidas
Voltar