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

    [Resolvido]Mensagem informativa x Texto rolando em formulário

    Compartilhe

    vinicius.anna
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 174
    Registrado : 29/04/2011

    [Resolvido]Mensagem informativa x Texto rolando em formulário

    Mensagem  vinicius.anna em Qua 14 Maio 2014, 19:42

    Boa tarde

    Em meu sistema tenho uma rotina de importação de arquivos texto. Esta rotina, após popular minha tabela primária, faz o desmembramento dos registros através da função abaixo:

    Código:

    Public Function fncCriaRegistros()
    On Error GoTo TrataErro
       
    MsgBox "Iniciando Criação dos Registros...", vbExclamation, "Tabelas Auxiliares..."
    'Registro 0000
    CurrentDb.Execute "INSERT INTO reg_0000 ( Registro, Lecd, DataInicial, DataFinal, Nome, Cnpj, UF, Ie, CodMunicipio, InscMunicipal, SitEspecial, Periodo, Nire, Finalidade ) SELECT tb_Sped.Campo1, tb_Sped.Campo2, tb_Sped.Campo3, tb_Sped.Campo4, tb_Sped.Campo5, tb_Sped.Campo6, tb_Sped.Campo7, tb_Sped.Campo8, tb_Sped.Campo9, tb_Sped.Campo10, tb_Sped.Campo11, tb_Sped.Campo12, tb_Sped.Campo13, tb_Sped.Campo14 FROM tb_Sped WHERE (((tb_Sped.Campo1)='0000'));"

    'Registro I050
    CurrentDb.Execute "INSERT INTO reg_I050 ( Registro, Data, Natureza, Classificacao, Nivel, Conta, Agrupador, NomeAgrupador ) SELECT tb_Sped.Campo1, tb_Sped.Campo2, tb_Sped.Campo3, tb_Sped.Campo4, tb_Sped.Campo5, tb_Sped.Campo6, tb_Sped.Campo7, tb_Sped.Campo8 FROM tb_Sped WHERE (((tb_Sped.Campo1)='I050' Or (tb_Sped.Campo1)='I051')) ORDER BY tb_Sped.Id;"
    CurrentDb.Execute "UPDATE reg_I050 SET reg_I050.Grau = '4' WHERE (((reg_I050.Classificacao)='A'));"
    CurrentDb.Execute "UPDATE reg_I050 SET reg_I050.Grau = '2' WHERE (((reg_I050.Nivel)='4'));"
    CurrentDb.Execute "UPDATE reg_I050 SET reg_I050.Grau = '3' WHERE (((reg_I050.Nivel)='5') AND ((reg_I050.Grau) Is Null));"
    CurrentDb.Execute "UPDATE reg_I050 SET reg_I050.Grau = '1' WHERE (((reg_I050.Nivel)='3') AND ((reg_I050.Grau) Is Null));"
    'Ajustando Conta Referencial - Registro I050
    CurrentDb.Execute "UPDATE reg_I050 SET reg_I050.Referencial = [Classificacao] WHERE (((reg_I050.Registro)='I051'));"
    CurrentDb.Execute "UPDATE reg_I050 SET reg_I050.Referencial = '' WHERE (((reg_I050.Classificacao)='A'));"
    CurrentDb.Execute "Delete reg_I050.Registro FROM reg_I050 WHERE (((reg_I050.Registro)='I051'));"
    CurrentDb.Execute "Delete reg_I050.Tipo_Exactus FROM reg_I050 WHERE (((reg_I050.Grau) Is Null));"

    'Registro I155
    CurrentDb.Execute "INSERT INTO reg_I155 ( Registro, CentroCustos, Conta, Natureza, SaldoInicial ) SELECT tb_Sped.Campo1, tb_Sped.Campo3, tb_Sped.Campo2, tb_Sped.Campo5, tb_Sped.Campo4 FROM tb_Sped WHERE (((tb_Sped.Campo1)='I150')) OR (((tb_Sped.Campo1)='I155')) ORDER BY tb_Sped.Id; "
    CurrentDb.Execute "UPDATE reg_I155 SET reg_I155.dtData = [Conta] WHERE (((reg_I155.Registro)='I150'));"
    CurrentDb.Execute "UPDATE reg_I155 SET reg_I155.Abertura = 'S';"
    'Call fncPreenche

    'Registro I250
    CurrentDb.Execute "INSERT INTO reg_I250 ( Registro, Conta, CentroCustos, ValorLanc, Natureza, Complemento ) SELECT tb_Sped.Campo1, tb_Sped.Campo2, tb_Sped.Campo3, tb_Sped.Campo4, tb_Sped.Campo5, tb_Sped.Campo8  FROM tb_Sped WHERE (((tb_Sped.Campo1)='I200')) OR (((tb_Sped.Campo1)='I250')) ORDER BY tb_Sped.Id; "
       
    MsgBox "Registros criados com Êxito!", vbInformation, "Tabelas Auxiliares..."
       
    Exit_TrataErro:
    Exit Function
    TrataErro:
    MsgBox "Falha de Processamento. fncCriaRegistros" _
          & vbCrLf & "Erro n°: " & Err.Number _
          & vbCrLf & "Descrição: " _
          & Err.Description, vbInformation, "Erro inesperado"
    Exit Function

    End Function

    A função funciona perfeitamente. Ocorre que, enquanto ela está em execução, dependendo do tamanho da tabela primária, dá-se a impressão que o sistema está "travado". Pesquisei bastante aqui no fórum, mas não encontrei o que almejo, que seria ao seguinte:

    Quando iniciar esta função, abrir um formulário (frm_Progresso) que mostrará o texto fixo, Aguarde, processando, ao lado de processando uma caixa de texto ou label que mostrará ... (três pontos) e funcionaria assim:

    Aguarde, Processando . (mostra o primeiro ponto)
    Aguarde, Processando .. (mostra o primeiro e segundo pontos)
    Aguarde, Processando ... (mostra o primeiro, segundo e terceiro pontos)
    Aguarde, Processando . (volta a mostrar o primeiro ponto)

    e assim sucessivamente, até que a função encerre a execução e feche o formulário.

    Algum amigo tem alguma dica de como possa fazer isto

    Obrigado.

    Att. Vinicius

    vinicius.anna
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 174
    Registrado : 29/04/2011

    Re: [Resolvido]Mensagem informativa x Texto rolando em formulário

    Mensagem  vinicius.anna em Qui 15 Maio 2014, 13:20

    Bom dia

    Resolvido através de um loop.

    Att. Vinicius

      Data/hora atual: Dom 19 Nov 2017, 21:14