MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

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

    Código Barras 8 Digitos

    Compartilhe

    Agravina
    VIP
    VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1296
    Registrado : 18/07/2010

    Código Barras 8 Digitos

    Mensagem  Agravina em Qui 13 Mar 2014, 12:05

    Tenho Códigos de barras de 8 digitos ,estou um código de um colega do forum para 7 e 13 digitos onde faço alterações para aceitar também 8 digitos

    segue abaixo o código que uso.


    Private Sub txtCodigoBarras_Exit(Cancel As Integer)
    On Error GoTo trataerro
    Dim QtdeProdutos As Integer
    Dim Linha
    Dim MsgErro

    'Checa variáveis para não abrir o form de pesquisa e nem emitir mensagem de erro para campo vazio
    If TeclaEsc = True Then Exit Sub

    If TeclaEsc = True Then TeclaEsc = False: Exit Sub

    If Me.txtCodigoBarras.Text <> "" Then

    'Checa se o código digitado é de 1, 7 ou 13. Caso não emite mensagem e encerra o evento
    If Len(Me.txtCodigoBarras.Text) <> 1 And Len(Me.txtCodigoBarras.Text) <> 7 And Len(Me.txtCodigoBarras.Text) <> 13 Then
    MsgBox "Código de Produto Inválido" _
    & vbNewLine & " Digite um Código Válido de:" _
    & vbNewLine & "1, 7 ou 13 Dígitos", vbCritical, "ERRO DE DIGITAÇÃO"
    Cancel = True
    Exit Sub
    End If

    ' Envia para o código que executa a inclusão de acordo com o tipo de código de produto
    If Len(Me.txtCodigoBarras.Text) = 1 Then GoTo Continua:
    If Len(Me.txtCodigoBarras.Text) = 7 Then GoTo Continua:
    If Len(Me.txtCodigoBarras.Text) = 13 Then GoTo Continua_13:

    Continua:
    '=============================================================================
    'se for escolhido apenas o produto sem o adendo do peso no código de barras
    '-----------------------------------------------------------------------------
    QtdeProdutos = Me.ltxProdutos.ListCount - 1
    For Linha = 0 To QtdeProdutos
    If Me.ltxProdutos.Column(1, Linha) = Me.txtCodigoBarras.Value Then
    Estoque = Me.ltxProdutos.Column(4, Linha)
    Me.txtDescricao.Value = Me.ltxProdutos.Column(2, Linha)
    Me.txtPrecoUnitario.Value = Format(Me.ltxProdutos.Column(3, Linha), "#,##0.00")
    If Incluir = True Then
    Me.IncluirProduto
    Cancel = True
    End If
    Exit Sub
    End If
    Next Linha
    MsgBox "Produto não cadastrado.", vbInformation, "SysPDV"
    Cancel = True
    Me.txtCodigoBarras.SetFocus
    Incluir = False
    Me.LimpaProduto
    'SendKeys "+{TAB}"
    Exit Sub
    '*******************************************************************************

    '=============================================================================
    'se for digitado código de 13 dígitos, verifica se o produto é de 7 digitos
    'ou de 13 digitos, enviando para o código adequado
    '-----------------------------------------------------------------------------
    Continua_13:
    'Pesquisa na tabela, em sendo produtos de 7 dígitos vai para o comando ProdPeso
    If DCount("*", "TblProdutos", "CodigoBarras ='" & Left(Me.txtCodigoBarras.Text, 7) & "'") = 1 Then GoTo ProdPeso
    QtdeProdutos = Me.ltxProdutos.ListCount - 1
    For Linha = 0 To QtdeProdutos
    If Me.ltxProdutos.Column(1, Linha) = Me.txtCodigoBarras.Value Then
    Estoque = Me.ltxProdutos.Column(4, Linha)
    Me.txtDescricao.Value = Me.ltxProdutos.Column(2, Linha)
    Me.txtPrecoUnitario.Value = Format(Me.ltxProdutos.Column(3, Linha), "#,##0.00")
    If Incluir = True Then
    Me.IncluirProduto
    Cancel = True
    End If
    Exit Sub
    End If
    Next Linha
    MsgBox "Produto não cadastrado.", vbInformation, "SysPDV"
    Cancel = True
    Me.txtCodigoBarras.SetFocus
    Incluir = False
    Me.LimpaProduto
    'SendKeys "+{TAB}"

    Exit Sub
    '=============================================================================
    'Executa cálculos de peso e valor para produtos da balança
    '-----------------------------------------------------------------------------
    ProdPeso:

    StrValorPeso = Mid(Me.txtCodigoBarras.Text, 7, 4) & "," & Right(Me.txtCodigoBarras.Text, 3)
    StrValorPeso = CDbl(StrValorPeso)
    Me.txtCodigoBarras = Left(Me.txtCodigoBarras.Text, 7)

    QtdeProdutos = Me.ltxProdutos.ListCount - 1
    For Linha = 0 To QtdeProdutos
    If Me.ltxProdutos.Column(1, Linha) = Me.txtCodigoBarras.Value Then
    Estoque = Me.ltxProdutos.Column(4, Linha)
    Me.txtDescricao.Value = Me.ltxProdutos.Column(2, Linha)
    Me.txtPrecoUnitario.Value = Format(Me.ltxProdutos.Column(3, Linha), "#,##0.00")
    StrPeso = Format(CDbl(StrValorPeso * 1000 / CDbl(Me.txtPrecoUnitario) / 1000), "#,##0.0000")
    Me.txtQtde = StrPeso
    If Incluir = True Then
    Me.IncluirProduto
    Cancel = True
    End If
    Exit Sub
    End If
    Next Linha
    MsgBox "Produto não cadastrado.", vbInformation, "SysPDV"
    Cancel = True
    Me.txtCodigoBarras.SetFocus
    Incluir = False
    Me.LimpaProduto
    'SendKeys "+{TAB}"

    Exit Sub
    End If
    '*******************************************************************************
    Exit_TrataErro:
    DoCmd.Hourglass False
    DoCmd.Echo True
    Exit Sub

    trataerro:
    If err.Number = 0 Then
    MsgBox "xxxxxxxxx", vbInformation, "Aviso"
    Else
    DoCmd.Hourglass False
    DoCmd.Echo True
    MsgErro = "Erro # " & Str(err.Number) & " gerado na " & err.Source _
    & vbNewLine & vbNewLine & "Descrição: " & err.Description _
    & vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
    MsgBox MsgErro, vbMsgBoxHelpButton + vbCritical, "Erro", err.Helpfile, err.HelpContext
    Resume Exit_TrataErro
    End If
    End Sub

    Sub InsereProdutos()
    'On Error GoTo trataerro
    Dim QtdeProdutos As Integer
    Dim Linha
    Dim MsgErro

    If Len(Me.txtCodigoBarras.Value) <> 1 And Len(Me.txtCodigoBarras.Value) <> 7 And Len(Me.txtCodigoBarras.Value) <> 13 Then
    MsgBox "Código de Produto Inválido" _
    & vbNewLine & " Digite um Código Válido de:" _
    & vbNewLine & "1, 7 ou 13 Dígitos", vbCritical, "ERRO DE DIGITAÇÃO"
    Cancel = True
    Exit Sub
    End If

    If Me.txtCodigoBarras.Value <> "" Then
    ' Envia para o código que executa a inclusão de acordo com o tipo de código de produto
    If Len(Me.txtCodigoBarras.Value) = 1 Then GoTo Continua:
    If Len(Me.txtCodigoBarras.Value) = 7 Then GoTo Continua:
    If Len(Me.txtCodigoBarras.Value) = 13 Then GoTo Continua_13:

    Continua:
    '=============================================================================
    'se for escolhido apenas o produto sem o adendo do peso no código de barras
    '-----------------------------------------------------------------------------
    QtdeProdutos = Me.ltxProdutos.ListCount - 1
    For Linha = 0 To QtdeProdutos
    If Me.ltxProdutos.Column(1, Linha) = Me.txtCodigoBarras.Value Then
    Estoque = Me.ltxProdutos.Column(4, Linha)
    Me.txtDescricao.Value = Me.ltxProdutos.Column(2, Linha)
    Me.txtPrecoUnitario.Value = Format(Me.ltxProdutos.Column(3, Linha), "#,##0.000")
    If Incluir = True Then
    Me.IncluirProduto
    Cancel = True
    End If
    Exit Sub
    End If
    Next Linha
    MsgBox "Produto não cadastrado.", vbInformation, "SysPDV"
    Cancel = True
    Me.txtCodigoBarras.SetFocus
    Incluir = False
    Me.LimpaProduto
    'SendKeys "+{TAB}"
    Exit Sub
    '*******************************************************************************

    '=============================================================================
    'se for digitado código de 13 dígitos, verifica se o produto é de 7 digitos
    'ou de 13 digitos, enviando para o código adequado
    '-----------------------------------------------------------------------------
    Continua_13:
    'Pesquisa na tabela, em sendo produtos de 7 dígitos vai para o comando ProdPeso
    If DCount("*", "TblProdutos", "CodigoBarras ='" & Left(Me.txtCodigoBarras.Value, 7) & "'") = 1 Then GoTo ProdPeso
    QtdeProdutos = Me.ltxProdutos.ListCount - 1
    For Linha = 0 To QtdeProdutos
    If Me.ltxProdutos.Column(1, Linha) = Me.txtCodigoBarras.Value Then
    Estoque = Me.ltxProdutos.Column(4, Linha)
    Me.txtDescricao.Value = Me.ltxProdutos.Column(2, Linha)
    Me.txtPrecoUnitario.Value = Format(Me.ltxProdutos.Column(3, Linha), "#,##0.000")
    If Incluir = True Then
    Me.IncluirProduto
    Cancel = True
    End If
    Exit Sub
    End If
    Next Linha
    MsgBox "Produto não cadastrado.", vbInformation, "SysPDV"
    Cancel = True
    Me.txtCodigoBarras.SetFocus
    Incluir = False
    Me.LimpaProduto
    'SendKeys "+{TAB}"

    Exit Sub
    '=============================================================================
    'Executa cálculos de peso e valor para produtos da balança
    '-----------------------------------------------------------------------------
    ProdPeso:

    StrValorPeso = Mid(Me.txtCodigoBarras.Value, 7, 4) & "," & Right(Me.txtCodigoBarras.Value, 3)
    StrValorPeso = CDbl(StrValorPeso)
    Me.txtCodigoBarras = Left(Me.txtCodigoBarras.Value, 7)

    QtdeProdutos = Me.ltxProdutos.ListCount - 1
    For Linha = 0 To QtdeProdutos
    If Me.ltxProdutos.Column(1, Linha) = Me.txtCodigoBarras.Value Then
    Estoque = Me.ltxProdutos.Column(4, Linha)
    Me.txtDescricao.Value = Me.ltxProdutos.Column(2, Linha)
    Me.txtPrecoUnitario.Value = Format(Me.ltxProdutos.Column(3, Linha), "#,##0.000")
    StrPeso = Format(CDbl(StrValorPeso * 1000 / CDbl(Me.txtPrecoUnitario) / 1000), "#,##0.0000")
    Me.txtQtde = StrPeso
    If Incluir = True Then
    Me.IncluirProduto
    Cancel = True
    End If
    Exit Sub
    End If
    Next Linha
    MsgBox "Produto não cadastrado.", vbInformation, "SysPDV"
    Cancel = True
    Me.txtCodigoBarras.SetFocus
    Incluir = False
    Me.LimpaProduto
    'SendKeys "+{TAB}"

    Exit Sub
    End If
    '*******************************************************************************
    Exit_TrataErro:
    DoCmd.Hourglass False
    DoCmd.Echo True
    Exit Sub

    trataerro:
    If err.Number = 0 Then
    MsgBox "xxxxxxxxx", vbInformation, "Aviso"
    Else
    DoCmd.Hourglass False
    DoCmd.Echo True
    MsgErro = "Erro # " & Str(err.Number) & " gerado na " & err.Source _
    & vbNewLine & vbNewLine & "Descrição: " & err.Description _
    & vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
    MsgBox MsgErro, vbMsgBoxHelpButton + vbCritical, "Erro", err.Helpfile, err.HelpContext
    Resume Exit_TrataErro
    End If
    End Sub

    Agravina
    VIP
    VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1296
    Registrado : 18/07/2010

    Re: Código Barras 8 Digitos

    Mensagem  Agravina em Qui 13 Mar 2014, 19:55

    Mensagem de erro "tipos incompatíveis."

    Agravina
    VIP
    VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1296
    Registrado : 18/07/2010

    Re: Código Barras 8 Digitos

    Mensagem  Agravina em Ter 01 Abr 2014, 22:46

    Up

    Agravina
    VIP
    VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1296
    Registrado : 18/07/2010

    Re: Código Barras 8 Digitos

    Mensagem  Agravina em Sex 04 Abr 2014, 23:35

    Up

      Data/hora atual: Dom 11 Dez 2016, 00:15