MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Código de Barras EAN 8 e EAN 13

    Yoshinho
    Yoshinho
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 6
    Registrado : 16/02/2011

    Código de Barras EAN 8 e EAN 13 Empty Código de Barras EAN 8 e EAN 13

    Mensagem  Yoshinho em 28/1/2015, 20:31

    Num dos PDVs, me pediram para habilitar a impressão de etiquetas para as gôndolas onde houvesse espaço com o código de barras. O resultado é essa função que ripei do Wikipedia (endereço nos créditos).
    Tamanho das etiquetas: 3x10, em duas colunas.
    Para chamar a função:
    No relatório:

    Private Sub Detalhe_Print(Cancel As Integer, PrintCount As Integer)
    Call EANBarcoder("Código de Barras que deseja imprimir", Me)
    End Sub

    No módulo:
    Option Compare Database
    ''-------------------------------------------------------------------------------
    '' Yoshinho 21/03/2014 Auto-reconhecimento EAN-8/EAN-13
    '' Conforme algoritmo do Wikipedia
    '' http://pt.wikipedia.org/wiki/EAN_13
    ''-------------------------------------------------------------------------------
    Function EANBarcoder(Ctrl As String, Rpt As Report)
    Dim XPos As Integer, Y1Pos As Integer, Y2Pos As Integer
    Dim FirstNumber As String, strPattern As String
    Dim LCode(10) As String, GCode(10) As String, RCode(10) As String
    Dim DelimiterBar As String

    If Ctrl = "" Then Exit Function
    BarcodeLength = Len(Ctrl)
    If BarcodeLength <> 8 And BarcodeLength <> 13 Then Exit Function
    For i = 1 To Len(Ctrl)
       NumberChars = Mid$(Ctrl, i, 1)
       If NumberChars Like "*[!0-9]*" Then Exit Function
    Next i

    Select Case Left(Ctrl, 1)
       Case 0: FirstNumber = "LLLLLL"
       Case 1: FirstNumber = "LLGLGG"
       Case 2: FirstNumber = "LLGGLG"
       Case 3: FirstNumber = "LLGGGL"
       Case 4: FirstNumber = "LGLLGG"
       Case 5: FirstNumber = "LGGLLG"
       Case 6: FirstNumber = "LGGGLL"
       Case 7: FirstNumber = "LGLGLG"
       Case 8: FirstNumber = "LGLGGL"
       Case 9: FirstNumber = "LGGLGL"
    End Select

    LCode(0) = "0001101"
    LCode(1) = "0011001"
    LCode(2) = "0010011"
    LCode(3) = "0111101"
    LCode(4) = "0100011"
    LCode(5) = "0110001"
    LCode(6) = "0101111"
    LCode(7) = "0111011"
    LCode(8) = "0110111"
    LCode(9) = "0001011"

    GCode(0) = "0100111"
    GCode(1) = "0110011"
    GCode(2) = "0011011"
    GCode(3) = "0100001"
    GCode(4) = "0011101"
    GCode(5) = "0111001"
    GCode(6) = "0000101"
    GCode(7) = "0010001"
    GCode(8) = "0001001"
    GCode(9) = "0010111"

    RCode(0) = "1110010"
    RCode(1) = "1100110"
    RCode(2) = "1101100"
    RCode(3) = "1000010"
    RCode(4) = "1011100"
    RCode(5) = "1001110"
    RCode(6) = "1010000"
    RCode(7) = "1000100"
    RCode(8) = "1001000"
    RCode(9) = "1110100"

    DelimiterBar = "101"

    Rpt.ScaleMode = 0
    Y1Pos = 1200: XPos = 400: BarWidth = 20
    lFirstNumber = CLng(Mid(Ctrl, 1, 1))
    Rpt.FontSize = 7: Rpt.CurrentX = XPos - 120: Rpt.CurrentY = Y1Pos + 250
    Rpt.Print IIf(BarcodeLength = 8, "<", lFirstNumber)

    For h = 0 To IIf(BarcodeLength = 8, 10, 14)
       Select Case h
           Case 0
               strPattern = DelimiterBar: Y2Pos = 1520
           Case 1 To IIf(BarcodeLength = 8, 4, 6)
               Q = Mid$(Ctrl, IIf(BarcodeLength = 8, h, h + 1), 1)
               D = IIf(BarcodeLength = 8, "L", Mid$(FirstNumber, h, 1))
               If D = "L" Then
                   strPattern = LCode(Q)
               Else
                   strPattern = GCode(Q)
               End If
               Y2Pos = 1450
           Case IIf(BarcodeLength = 8, 5, 7) '7
               strPattern = "0" & DelimiterBar & "0": Y2Pos = 1520
           Case IIf(BarcodeLength = 8, 6, 8) To IIf(BarcodeLength = 8, 9, 13)
               Q = Mid$(Ctrl, IIf(BarcodeLength = 8, h - 1, h), 1)
               strPattern = RCode(Q): Y2Pos = 1450
           Case IIf(BarcodeLength = 8, 10, 14)
               strPattern = DelimiterBar: Y2Pos = 1520
       End Select
       
       For i = 1 To Len(strPattern)
     
           tempPattern = Mid(strPattern, i, 1)
           Rpt.Line (XPos, Y1Pos)-(XPos + BarWidth, Y2Pos), _
                IIf(tempPattern = "1", &H0&, &HFFFFFF), BF
           XPos = XPos + BarWidth + 1
       
       Next i
       
       Rpt.ForeColor = &H0&: Rpt.CurrentX = XPos - 95: Rpt.CurrentY = Y1Pos + 250
       Rpt.Print CStr(Q)
       Q = ""
       
    Next h

       Rpt.CurrentX = XPos + 70: Rpt.CurrentY = Y1Pos + 250
       If BarcodeLength = 8 Then Rpt.Print ">"

    End Function


    Para uma maior performance, seria interessante carregar as variáveis uma única vez.
    Fernando Bueno
    Fernando Bueno
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2097
    Registrado : 13/04/2012

    Código de Barras EAN 8 e EAN 13 Empty Re: Código de Barras EAN 8 e EAN 13

    Mensagem  Fernando Bueno em 1/2/2015, 18:51

    Muito bom amigo, obrigado por compartilhar!


    .................................................................................
    Um abraço
    Fernando Bueno


    O aumento do conhecimento é como uma esfera dilatando-se no espaço
    quanto maior a nossa compreensão,
    maior o nosso contacto com o desconhecido
    Código de Barras EAN 8 e EAN 13 16rzeq
    Yoshinho
    Yoshinho
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 6
    Registrado : 16/02/2011

    Código de Barras EAN 8 e EAN 13 Empty PS

    Mensagem  Yoshinho em 3/2/2015, 13:28

    Apenas uma observação, Fernando Bueno: a função não faz a checagem do DV. Sendo assim, mesmo tendo uma Len de 8 ou 13, sem o DV correto, o código de barras é gerado mas não é lido pelo scanner.

    Levei em conta que os dados inseridos (em tabela, no caso) já estejam totalmente formatados e corretos.

      Data/hora atual: 29/11/2020, 16:14