MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    Código Barras 8 Digitos

    Compartilhe
    avatar
    Agravina
    VIP
    VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1349
    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
    avatar
    Agravina
    VIP
    VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1349
    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."
    avatar
    Agravina
    VIP
    VIP

    Respeito às Regras 100%

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

    Re: Código Barras 8 Digitos

    Mensagem  Agravina em Ter 01 Abr 2014, 22:46

    Up
    avatar
    Agravina
    VIP
    VIP

    Respeito às Regras 100%

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

    Re: Código Barras 8 Digitos

    Mensagem  Agravina em Sex 04 Abr 2014, 23:35

    Up

      Data/hora atual: Sex 15 Dez 2017, 00:23