[Resolvido]Criação de Plano de Contas Contábil x VBA

Boa tarde

Estou criando um plano de contas contábil e estou com uma dificuldade onde, tenho uma tabela com os grupos, onde os mesmos contém o código inicial para geração da conta. O que ocorre é que não consigo fazer com que seja respeitado o código inicial informado na tabela grupos para a tabela do plano de contas.

Tenho as seguintes tabelas:

tb_Classes:
Id_Classe Inteiro longo 4
Grupo Texto Curto 255
Descrição Texto Curto 255
Classe Texto Curto 255
CodIni1 Duplo 8

reg_I050 (plano de contas):
Id_Registro Inteiro longo 4
Conta Texto Curto 255
NomeAgrupador Texto Curto 255
Grau Texto Curto 255
Item_Plano Texto Curto 255
Id_Classe Inteiro longo 4
Conta_Plano Texto Curto 255
CodIni Texto Curto 255


Tenho uma relação criada entre ambas as tabelas para a classe pois, na tabela classe através do campo CodIni1, tenho o número inicial para a geração daquele grupo de contas.


Estou usando o código abaixo para gerar as contas:

Código:


On Error GoTo TrataErro
Dim Rs As DAO.Recordset
Dim ContaItem As Double
Dim MontaContador As Double
Dim VarIni As Double

Set Rs = CurrentDb.OpenRecordset("SELECT reg_I050.Id_Registro, reg_I050.Conta, reg_I050.NomeAgrupador, reg_I050.Grau, reg_I050.Item_Plano, reg_I050.Id_Classe, reg_I050.Conta_Plano, reg_I050.CodIni FROM reg_I050 WHERE (((reg_I050.Grau)='2'));")

Do While Not Rs.EOF
    Rs.Edit
   
    'Rs(0) - Id_Registro
    'Rs(1) - Conta
    'Rs(2) - NomeAgrupador
    'Rs(3) - Grau
    'Rs(4) - Item_Plano
    'Rs(5) - Id_Classe
    'Rs(6) - Conta_Plano
    'Rs(7) - CodIni - Tabela Classes
   
    If Rs(3) = "2" Then
        VarIni = Rs(7)
        ContaItem = ContaItem + 1
        MontaContador = ContaItem
        Rs(6) = Format(MontaContador, "1000")
        Rs.Update
    Else
        ContaItem = 0
    End If
   
    Rs.MoveNext
Loop

Rs.Close

MsgBox "Contas Montadas com sucesso.", vbInformation, "Processo Completado OK."

Exit_TrataErro:
Exit Sub

TrataErro:
    Select Case Err.Number
        Case 94
            Resume Next
        Case Else
            MsgBox "Erro na Montagem!! " & vbCrLf & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", _
            Err.HelpFile, Err.HelpContext
    End Select
    Resume TrataErro:



Minha dificuldade é que, preciso respeitar o código inicial informado na tabela classes para que comece a montagem da conta e não estou conseguindo fazer isto...., consigo apenas gerar um número sequencial.......


Alguém tem alguma dica de como possa fazê-lo

o link para download:

http://www.sendspace.com/file/xjbm48

Att.
Vinicius

eu tenho um projeto mas e diferente do que vc quer

Boa tarde

Na verdade, o que estou fazendo é, pegando um arquivo SPED Contábil e importando. A partir do desmembramento do sped, pegando o registro I050, que é o plano de contas, preciso montar um novo plano de contas, baseado no arquivo importado....., os itens, gero sem problemas....., o problema realmente é ao tentar fazer com que a hierarquia das contas obedeça os valores informados na tabela de grupos.

Att. Vinicius

NADIRONUNES, baixei teu arquivo e visualizei como você cadastrou seu plano de contas contábil, mas preciso saber como você fez para gerar os códigos.

Agradeço sua contribuição.

cara eu trabalhava na contabilidade, esse codigo eu tive que criar uma a um

Boa tarde

Estou quase conseguindoo montar da forma que preciso, evitando qualquer digitação...., estou com uns 90% pronto......, só não estou conseguindo fazer com que o meu módulo entenda o código de início da tabela grupos que indica a natureza da conta (ativo circulante e suas subdivisões, ativo não circulante, passivo, etc).

A lógica funciona assim:

Na tabela REG_I050 tenho os Campos GRAU e Id_Classe. O Id_Classe vem da tabela tb_Classes com a indicação da natureza da conta (se ativo, passivo ou resultado) e além desta indicação tenho no registro da classe, na tabela classes o código inicial para a geração da conta. Exemplo

Conta Grau Id_Classe
XXXXX 1 1
XXXXX 2
XXXXX 3
XXXXX 4
XXXXX 2
XXXXX 3
XXXXX 4
XXXXX 4
XXXXX 4
XXXXX 2
XXXXX 3
XXXXX 4
YYYYY 1 2
YYYYY 2
YYYYY 3
YYYYY 4
YYYYY 4
YYYYY 2
YYYYY 3
YYYYY 4
ZZZZZ 1 6
ZZZZZ 2
ZZZZZ 3
ZZZZZ 4
ZZZZZ 4
ZZZZZ 2
ZZZZZ 3
ZZZZZ 4
ZZZZZ 4
ZZZZZ 1 6
ZZZZZ 2
ZZZZZ 3
ZZZZZ 4

O Id 1 indica que a conta deve iniciar com 1000 e o id 2, 1100, e o Id 6, 1500.

O resultado esperado é este:

Conta Grau Id_Classe
1000 1 1
1000 2
1000 3
1000 4
1001 2
1001 3
1001 4
1001 4
1001 4
1002 2
1002 3
1002 4
1100 1 2
1100 2
1100 3
1100 4
1100 4
1101 2
1101 3
1101 4
1500 1 6
1500 2
1500 3
1500 4
1500 4
1501 2
1501 3
1501 4
1501 4
1502 1 6
1502 2
1502 3
1502 4

Então funciona assim:
-apenas as contas de grau 1 possuirão a indicação do grau;
- quando houver um grau 2, somo +1 e repito os valores para grau 3 e 4 até encontrar o próximo grau 2;
quando houver grau 1 e o id do grupo for o mesmo do anterior (exemplo id 6), apenas mantenho a contagem.

Muito obrigado.

Att. Vinicius

poste o exemplo

Boa tarde

Segue o exemplo.....

No botão 2 estou montando a função para a geração.....

A especificação do plano de contas é....., trabalho com 7, 9 ou 16 dígitos para o mesmo.....

Att. Vinicius

Boa tarde

Possuo duas tabelas correlacionadas.  Na tabela reg_I050, possuo o campo Id_Classe (relacionado com a tabela classes), que armazena o código de início para a geração do contador. Minha dificuldade é que não consigo fazer com que meu contador entenda o código inicial.

A lógica que estou tentando empregar é:

Na tabela REG_I050 tenho os Campos GRAU e Id_Classe. O Id_Classe vem da tabela tb_Classes com a indicação da natureza da conta (se ativo, passivo ou resultado) e além desta indicação tenho no registro da classe, na tabela classes o código inicial para a geração da conta. Exemplo

Conta    Grau  Id_Classe
XXXXX    1        1
XXXXX    2        
XXXXX    3      
XXXXX    4
XXXXX    2        
XXXXX    3      
XXXXX    4
XXXXX    4
XXXXX    4
XXXXX    2        
XXXXX    3      
XXXXX    4
YYYYY    1         2
YYYYY    2        
YYYYY    3
YYYYY    4
YYYYY    4
YYYYY    2        
YYYYY    3
YYYYY    4
ZZZZZ     1         6                          
ZZZZZ     2          
ZZZZZ     3
ZZZZZ     4
ZZZZZ     4
ZZZZZ     2
ZZZZZ     3
ZZZZZ     4
ZZZZZ     4
ZZZZZ    1         6                          
ZZZZZ     2          
ZZZZZ    3
ZZZZZ    4

O Id 1 indica que a conta deve iniciar com 1000 e o id 2, 1100, e o Id 6, 1500 e assim sucessivamente.

O resultado esperado é este:

Conta    Grau  Id_Classe
1000    1        1
1000    2        
1000    3      
1000    4
1001    2        
1001    3      
1001    4
1001    4
1001    4
1002    2        
1002    3      
1002    4
1100    1         2
1100    2        
1100    3
1100    4
1100    4
1101    2        
1101    3
1101    4
1500     1         6                          
1500     2          
1500     3
1500     4
1500     4
1501     2
1501     3
1501     4
1501     4
1502     1         6                          
1502     2          
1502     3
1502     4

Então funciona assim:
-apenas as contas de grau 1 possuirão a indicação do grau;
- quando houver um grau 2, somo +1 e repito os valores para grau 3 e 4 até encontrar o próximo grau 2;
quando houver grau 1 e o id do grupo for o mesmo do anterior (exemplo id 6), apenas mantenho a contagem.

No exemplo em anexo, no formulário Plano de Contas tenho~:
a - A indicação para a classe da conta;
b - Os botões para criação de itens e contas.

O botão criar itens funciona perfeitamente. A dificuldade está no botão montar contas.

Algum amigo tem alguma dica de como possa fazê-lo.

Att. Vinicius

Olá,

Precisei mudar o tipo de dado do campo grau para Número. Faça também da mesma forma ou use alguma função para converter em tempo de execução.

Escrevi esse código para fazer a função dos dois botões (1 e 2) da sua amostra. A função do 1° está fazendo na perfeição e a do 2° saberemos depois que você observar a ação.

Aperte no botão limpar e depois aplique este a partir de um botão:

On Error GoTo TratareiErro
Dim rSt As DAO.Recordset
Dim nGrau As Long
Dim buscaConta As Long
Dim contaBuscada As Long
Dim incConta As Long
Dim oldConta As Long
Set rSt = CurrentDb.OpenRecordset("reg_I050")
rSt.MoveLast
rSt.MoveFirst
incConta = 0
   Do While Not rSt.EOF
         nGrau = rSt("Grau")
         buscaConta = Nz(rSt("Id_Classe"))
         If nGrau = 1 Then
         contaBuscada = Nz(DLookup("CodIni1", "tb_Classes", _
                                   "Id_Classe =" & buscaConta))
         End If
         rSt.Edit
         If nGrau = 1 Then
             rSt("ContaExa") = contaBuscada
             rSt("CodIni") = contaBuscada
         ElseIf nGrau = 2 And oldConta > 0 Then
             rSt("ContaExa") = contaBuscada
             incConta = contaBuscada
             contaBuscada = contaBuscada + 1
         ElseIf nGrau = 2 And oldConta = 0 Then
             incConta = incConta + 1
             rSt("ContaExa") = incConta
         ElseIf nGrau > 2 And oldConta = 0 Then
             rSt("ContaExa") = incConta
         End If
         rSt.Update
         oldConta = buscaConta
         rSt.MoveNext
   Loop
rSt.Close
Exit_TratareiErro:
Exit Sub
TratareiErro:
MsgBox "Aconteceu falha neste processamento." _
      & vbCrLf & "Trata-se do erro n°: " & Err.Number _
      & vbCrLf & "Descrição: " _
      & Err.Description, vbInformation, "Erro inesperado"
Exit Sub

Dílson,



Boa tarde,



Muito obrigado....., aqui está o backup já com a função:



http://www.sendspace.com/file/h1h5k2



Tenho apenas mais dois detalhes:



o primeiro é o seguinte:



- O código que montou funciona perfeitamente, sem erros e gera quase 100% do que preciso, porém (no backup atualizado onde disponibilizei o link em anexo a este):



-- Na tabela Reg_I050, o registro de chave primária 12 é um registro de grau 3, o grau anterior é o grau 4, então tentei fazer com que acrescenta-se + 1 ao campo contaexa. Ficou 1001, porém, preciso que fique 1002......



--- O outro detalhe, não sei se é possível:



* Na tabela classes, tenho os códigos iniciais para a montagem das contas. Perfeito, está funcionando como deve. O que ocorre é que, por exemplo, a classe 1, pode ser usada em mais de uma conta de grau 1, e desta forma, precisaria manter a contagem para a montagem da conta.



Mais uma vez, muito obrigado pela ajuda e tempo já dispensados.



Att. Vinicius

Ok vamos gradativamente.

Para atender ao primeiro detalhe que citou, substitua o código por este:

Dim rSt As DAO.Recordset
Dim nGrau As Long
Dim buscaConta As Long
Dim contaBuscada As Long
Dim incConta As Long
Dim oldConta As Long
Dim oldGrau As Long
Set rSt = CurrentDb.OpenRecordset("reg_I050")
rSt.MoveLast
rSt.MoveFirst
incConta = 0
    Do While Not rSt.EOF
          nGrau = rSt("Grau")
          buscaConta = Nz(rSt("Id_Classe"))
          If nGrau = 1 Then
          contaBuscada = Nz(DLookup("CodIni1", "tb_Classes", _
                                    "Id_Classe =" & buscaConta))
          End If
          rSt.Edit
          If nGrau = 1 Then
              rSt("ContaExa") = contaBuscada
              rSt("CodIni") = contaBuscada
          ElseIf nGrau = 2 And oldConta > 0 Then
              rSt("ContaExa") = contaBuscada
              incConta = contaBuscada
              contaBuscada = contaBuscada + 1
          ElseIf nGrau = 2 And oldConta = 0 Then
              incConta = incConta + 1
              rSt("ContaExa") = incConta
          ElseIf nGrau > 3 And oldConta = 0 Then
              rSt("ContaExa") = incConta
          ElseIf nGrau = 3 And oldConta = 0 And oldGrau = 2 Then
              rSt("ContaExa") = incConta
          ElseIf nGrau = 3 And oldConta = 0 And oldGrau = 4 Then
              incConta = incConta + 1
              rSt("ContaExa") = incConta
          End If
          rSt.Update
          oldConta = buscaConta
          oldGrau = nGrau
          rSt.MoveNext
    Loop
rSt.Close

Retorne para tratarmos ou avançarmos ao segundo detalhe.

Boa tarde


Dilson,


Obrigado


Com esta função, funcionou perfeitamente, restando apenas a questão da classe poder ser usada mais de uma vez.


Mais uma vez, muito obrigado.


Att.

Vinicius

Ok, agora experimente substitua o código por este abaixo que implementei para também atender ao segundo detalhe:

Dim rSt As DAO.Recordset
Dim nGrau As Long
Dim buscaConta As Long
Dim contaBuscada As Long
Dim incConta As Long
Dim oldConta As Long
Dim oldGrau As Long
Dim oldClasse As Long
Dim incClasse As Long
Set rSt = CurrentDb.OpenRecordset("reg_I050")
rSt.MoveLast
rSt.MoveFirst
incConta = 0
incClasse = 0
    Do While Not rSt.EOF
          nGrau = rSt("Grau")
          buscaConta = Nz(rSt("Id_Classe"))
          If nGrau = 1 Then
          contaBuscada = Nz(DLookup("CodIni1", "tb_Classes", _
                                    "Id_Classe =" & buscaConta))
          End If
          rSt.Edit
          
          If nGrau = 1 Then
              rSt("ContaExa") = contaBuscada
              rSt("CodIni") = contaBuscada
                            
          ElseIf nGrau = 2 And oldConta > 0 Then
              rSt("ContaExa") = contaBuscada
              incConta = contaBuscada
              contaBuscada = contaBuscada + 1
          ElseIf nGrau = 2 And oldConta = 0 Then
              incConta = incConta + 1
              rSt("ContaExa") = incConta
          ElseIf nGrau > 3 And oldConta = 0 Then
              rSt("ContaExa") = incConta
          ElseIf nGrau = 3 And oldConta = 0 And oldGrau = 2 Then
              rSt("ContaExa") = incConta
          ElseIf nGrau = 3 And oldConta = 0 And oldGrau = 4 Then
              incConta = incConta + 1
              rSt("ContaExa") = incConta
          End If
          If oldClasse = buscaConta Then
               If incClasse = 0 Then
                        incClasse = incConta + 1
                        contaBuscada = incClasse
                        rSt("ContaExa") = contaBuscada
                        incClasse = contaBuscada
                   Else
                        incClasse = incConta + 1
                        contaBuscada = incClasse
                        rSt("ContaExa") = contaBuscada
                        incClasse = contaBuscada
               End If
          End If
          rSt.Update
          oldConta = buscaConta
          oldGrau = nGrau
          If nGrau = 1 Then
          oldClasse = buscaConta
          End If
          rSt.MoveNext
    Loop
rSt.Close

Retorne para tratarmos ou informar o resolvido.

Dilson,


Boa tarde


Desculpe a demora em retornar mas estava viajando. Fiz os devidos testes e o processo ficou funcionando de forma correta. Agradeç_lhe imensamente pela atenção e ajuda.


Att. Vinicius