[Resolvido]Modelo de EAN13 em formulário

Alguém teria algum exemplo de código de barras EAN13 em formulário com digito verificador sem OCX ?
Não achei algo concreto parecido com a imagem em anexo...

País de origem do produto
Empresa fabricante
Produto por ela produzido
Dígito verificador

At.

Luis

Aqui está um exemplo de parte de um dos meus aplicativos.

Explicando, o código de barras propriamente dito (as barras) somente será exibido

no relatório e não no formulário.

Acredito que não precise que a mesma apareça no formulário, mas como é

feito de controle caixa, pode ser feito.

copie e cole na barra de endereços do navegador:

maximoaccess.com/t19402-resolvidoenviar-relatorio-para-impressora#144217

[ ]'s

Boa noite,

Creio que o seguinte tópico esteja relacionado com a sua questão.

Gerar 82 diferente Códigos

Cumprimentos

Quase lá !

Consegui calcular o dígito verificador, testei em aplicativo próprio para códigos de barra e está a funcionar...
Baixei fonte EAN-13.
Consegui um resultado satisfatório em termos de estética.

Tudo isso sem OCX só VBA.

Problema !

O leitor não lê a impressão...

Alguém tem uma ideia ?

Luis

Uma pergunta:

Cadê o código de barra?

Não o vejo nem no formulário e nem no relatório.

Sobre o leitor, tem que configurar, veja o manual dele.

Noobezinho, boa noite.
Tem que copiar a font EAN-13 que está na pasta junto com o arquivo, para C:\Windows\Fonts.
A imagem ficou assim como no anexo.
Quanto a configuração do leitor, vou ver aqui.

O que está na imagem, já tinha visto.

Pergunto sobre as barras que já deveriam estar no relatório, como no meu exemplo.

[ ]'s

Então, Noobezinho pra mim aqui tá saindo normal no relatório...como imagem em anexo.
O problema mesmo é a leitura...tenho vários leitores aqui e coletores que funcionam normal com impressão em Delphi e C# talvez pelos componentes, sem ter que configurar nada, mas no  MSACCESS tá me dando trabalho.
Acho o MSACCESS interessante pela facilidade de desenvolvimento, mas cheguei neste ponto de código de barras onde empaquei.

Utilizava esta OCX a um tempo mas pela troca de versão de SO WIN10 64 e alguns bloqueios de acesso não consegui registra-la mais queria uma solução alternativa, achei que uma fonte  true type daria certo, mas vejo que não é tão simples...

Continuo em busca de uma solução nem que seja só para EAN13 VBA ou OCX...

At.

Luis

Experimente ler o código de barras dos registros em meu exemplo.

Assim verificamos se consegue ou não ler meu exemplo.

Aguardo...

As tabelas estão vinculadas...
Não abre o relatório...

Da mensagem em anexo...

Luis

Quando eu fiz a substituição do Code39, esqueci de adicionar  o Back-End.

Por favor, faça o download novamente.

Download

Maravilha, funcionando.

Só um detalhe !

Funcionou perfeitamente no WIN7 com OFFICE 2007.
Mas no WIN10 com OFFICE2016 dá uma série de mensagens e não abre o relatório...
Por acaso tem este exemplo compilado para WIN10 / OFFICE2016 ?

Tentei mudar as rotinas aqui mas sem sucesso...não consegui adaptar.
Os erros se dão nesta rotina...

'Função para criação de códigos de barras padrão EAN 13
'Utiliza tabelas auxiliares tblEANAuxiliar e tblEAN13Caracter para definir as barras
'O algorítimo e processo de definição das barras estão publicados na revista Fórum Access
'Autor:- Mauro Possatto (Fórum Access)
'Data:- 28/10/97
'Alterações:-
'Alterado por Balem
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)

   
   Dim intValor As Integer
   
   Dim rs13Dig As Recordset
   Dim rsBarra As Recordset
   Dim strBarra As String, strTabela As String, strCor As String
   Dim i As Integer, J As Integer
   Dim dblEsquerda As Double
   
   'Constantes para alinhamento das barras
   
   Const CTwips = 567
   Const CTop = 0.9 * CTwips
   Const CWidth = 0.033 * CTwips
   
   
   dblEsquerda = 0.228 * CTwips
   
   'Alinhamento das barras auxiliares de guarda da esquerda
   For i = 1 To 3
       Me("BoxE" & i).Left = dblEsquerda
       Me("BoxE" & i).Top = CTop
       Me("BoxE" & i).Width = CWidth
       Me("BoxE" & i).Height = 1.297 * CTwips
       dblEsquerda = dblEsquerda + CWidth
   Next
   
   'Alinhamento das barras do primeiro conjunto de dígitos
   For i = 1 To 6
       For J = 1 To 7
           Me("Box" & i & J).Left = dblEsquerda
           Me("Box" & i & J).Top = CTop
           Me("Box" & i & J).Width = CWidth
           Me("Box" & i & J).Height = 1.143 * CTwips
           dblEsquerda = dblEsquerda + CWidth
       Next
   Next
   
   'Alinhamento das barras auxiliares centrais
   For i = 1 To 5
       Me("BoxC" & i).Left = dblEsquerda
       Me("BoxC" & i).Top = CTop
       Me("BoxC" & i).Width = CWidth
       Me("BoxC" & i).Height = 1.297 * CTwips
       dblEsquerda = dblEsquerda + CWidth
   Next
   
   'Alinhamento das barras do segundo conjunto de dígitos
   For i = 7 To 12
       For J = 1 To 7
           Me("Box" & i & J).Left = dblEsquerda
           Me("Box" & i & J).Top = CTop
           Me("Box" & i & J).Width = CWidth
           Me("Box" & i & J).Height = 1.143 * CTwips
           dblEsquerda = dblEsquerda + CWidth
       Next
   Next
   
   'Alinhamento das barras auxiliares de guarda da direita
   For i = 1 To 3
       Me("BoxD" & i).Left = dblEsquerda
       Me("BoxD" & i).Top = CTop
       Me("BoxD" & i).Width = CWidth
       Me("BoxD" & i).Height = 1.297 * CTwips
       dblEsquerda = dblEsquerda + CWidth
   Next
 
    Call AbrirDatabase
   
   'Abre a tabela de determinação do 13o. dígito
   Set rs13Dig = db.OpenRecordset("tblEAN13caractere", dbOpenTable)
   rs13Dig.Index = "PrimaryKey"
   rs13Dig.Seek "=", CInt(Left(strCod, 1))
   
   'Abre a tabela de determinação de barras
   Set rsBarra = db.OpenRecordset("tblEANAuxiliar", dbOpenTable)
   rsBarra.Index = "PrimaryKey"
       
   'Monta as barras do primeiro conjunto de dígitos
   For i = 2 To 7
       strTabela = Mid(rs13Dig!strTabela, i - 1, 1)
       intValor = CInt(Mid(strCod, i, 1))
       rsBarra.Seek "=", intValor
       Select Case strTabela
           Case Is = "A"
               strCor = rsBarra!strTabelaA
           Case Is = "B"
               strCor = rsBarra!strTabelaB
       End Select
       For J = 1 To 7
           If Mid(strCor, J, 1) = 0 Then
               Me("Box" & i - 1 & J).BackColor = 16777215
           Else
               Me("Box" & i - 1 & J).BackColor = 0
           End If
       Next
   Next
   
   'Monta as barras do segundo conjunto de dígitos
   For i = 8 To 13
       intValor = CInt(Mid(strCod, i, 1))
       rsBarra.Seek "=", intValor
       strCor = rsBarra!strTabelaC
       For J = 1 To 7
           If Mid(strCor, J, 1) = 0 Then
               Me("Box" & i - 1 & J).BackColor = 16777215
           Else
               Me("Box" & i - 1 & J).BackColor = 0
           End If
       Next
   Next
   
   'Monta as barras auxiliares de guarda e centrais
   Me.BoxE1.BackColor = 0
   Me.BoxE3.BackColor = 0
   Me.BoxE2.BackColor = 16777215
   Me.BoxD1.BackColor = 0
   Me.BoxD3.BackColor = 0
   Me.BoxD2.BackColor = 16777215
   Me.BoxC2.BackColor = 0
   Me.BoxC4.BackColor = 0
   Me.BoxC1.BackColor = 16777215
   Me.BoxC3.BackColor = 16777215
   Me.BoxC5.BackColor = 16777215
   
   'Executa o fechamento das tabelas e banco de dados abertos em memória
   rsBarra.Close
   rs13Dig.Close
   
       
End Sub

Disse que deu erros, mas não disse quais.

Uso o Access 2010 e Win 7

Mas olhando aqui, não vejo nada que pudesse dar erros.

Mas, poderemos ainda verificar onde está esse(s) erro(s) no teu pc, se

souber depurar o código VBA

Sabe usar ponto de interrupção e depurar o código VBA?

Aguardo...

Em anexo.

Veja que no exemplo tem uma função que é usada sempre que se precisa abrir um recordeset.

Ela se chama AbrirDatabase

Ela mostra para o Access, o caminho da base de dados (Back End)

Veja:

Public Function AbrirDatabase()
On Error Resume Next
Dim wsp As Workspace
Set wsp = DBEngine.Workspaces(0)
Dim DBTeste As String

DBTeste = DB.Name

If Err.Number = 3420 Or Err.Number = 91 Then
  Set DB = wsp.OpenDatabase("D:\Dropbox\Trabalhos\Access-Exemplos\Code39\code39_DB.accdb")
End If

End Function

A linha em vermelho mostra o caminho da pasta onde está a base de dados no meu pc.

Mude ela para o caminho da pasta do arquivo, no teu pc.

Noobezinho, grato pela ajuda já havia feito isto...

C:\Dropbox\Trabalhos\Access-Exemplos\code39_DB.accdb

Fiz o seguinte recriei a pasta e dei permissão de administrador pra ela OK, a mensagem foi sanada...
Agora me deparei com a mensagem "13", tipos incompatíveis nesta linha...

rs13Dig.Seek "=", CInt(Left(strCod, 1))

OK,
Acabei por referenciar um Componente Activex que utilizo no visual studio...BarcodeLabeler/Buy BarcodeX.
Blz, está a funcionar...

Agradeço pelo tempo despendido para me ajudar...
No Win7 Office 2007 tá rodando uma beleza...estou convertendo todos os ps's aqui para Win10 Office 2016 vou deixar este para testes...

Estou dando tópico como resolvido, grato.

Abraço.

Resolvido.

Ótimo que resolveu Luis


Valeu o retorno!


Só falta colocar o [Resolvido] no título do tópico.

É só editar uma das tuas mensagens e clicar no botão resolvido.

Caso não saiba como, veja ali na minha assinatura.


Boa sorte !