Código Barras 8 Digitos

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

Mensagem de erro "tipos incompatíveis."

Up

Up