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]Barra de progresso em importação

    Compartilhe

    Maurício Bruno
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 207
    Registrado : 25/05/2015

    [Resolvido]Barra de progresso em importação

    Mensagem  Maurício Bruno em Seg 24 Abr 2017, 14:27

    Olá amigos,
    É possível durante a importação haver uma barra de progresso?

    Tentei fazer uma barra de progresso e ela não funcionou, ela nem inicia, segue abaixo o base modelo que fiz.

    Esta barra contaria com varias mensagens durante o carregamento, tipo os exemplo abaixo:
    1 - "Iniciando Processo..."
    2 - "Verificando Base de Dados..."
    3 - "Iniciando Importação..."
    4 - "Importando Base de Dados..."
    5 - "Importação do Base de Dados Concluída..."
    6 - "Classificando Chamados no Base de Dados..."
    7 - "Classificação Concluída..."
    8 - "Importação e Classificação Concluída com Sucesso..."

    Obrigado pela ajuda e atenção.
    Anexos
    IMPORTAÇÃO.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (162 Kb) Baixado 10 vez(es)
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4402
    Registrado : 15/03/2013

    Re: [Resolvido]Barra de progresso em importação

    Mensagem  ahteixeira em Seg 24 Abr 2017, 14:52

    Olá Maurício,
    Não devemos misturar dúvidas.
    O tópico foi dividio.

    Ralativamente à questão:
    a) o código apresenta erros de compilação, verifique
    b) o botão para iniciar a importação (btIniciarBackup) não tem código nenhum de importação, ajuste


    Abraço

    Maurício Bruno
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 207
    Registrado : 25/05/2015

    Barra de progresso em importação

    Mensagem  Maurício Bruno em Seg 24 Abr 2017, 16:37

    ahteixeira,

    Desculpe a confusão com o tópicos.

    Ajustei o código.

    O Formulário há 02 botões, um faz a importação e classifica, ou seja, executa a funcionalidade que eu quero.

    Já o outro botão seria uma melhoria visual com uma barra de progresso, o código e o mesmo com algumas adicionei de funcionalidades de barra de progresso, porém, a barra não funciona.

    Acho que estou errando e alguma coisa.

    Obrigado pela atenção e ajuda.
    Anexos
    IMPORTAÇÃO.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (150 Kb) Baixado 16 vez(es)
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4402
    Registrado : 15/03/2013

    Re: [Resolvido]Barra de progresso em importação

    Mensagem  ahteixeira em Seg 24 Abr 2017, 16:54

    Olá, ainda apresenta erros o exemplo anexo, deve:
    ALT+F11 -> DEBUG e Compile
    Hoje estou com pouco tempo, e não compreendi bem o seu código.
    No entanto onde está a apresentar a "mensagem" , na linah a seguir experimente:
           DoEvents

    Abraço

    Maurício Bruno
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 207
    Registrado : 25/05/2015

    Barra de progresso em importação

    Mensagem  Maurício Bruno em Ter 16 Maio 2017, 21:07

    Desculpe, mas fiz e refiz e continua com o mesmo problema e não estou conseguindo resolver.
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4402
    Registrado : 15/03/2013

    Re: [Resolvido]Barra de progresso em importação

    Mensagem  ahteixeira em Sab 20 Maio 2017, 02:11

    Olá Maurício,
    Como referi o código que postou apresenta erros.
    Deveria ter retificado e postado novo exemplo sem erros.
    Eu dei a pista DoEvents

    Além disso não compreendo porque motivo a importação está a ser efetuada no evento Form_Timer
    Vai dar erros, mas vai mostrar o caminho das pedras.

    Altere o seu código do exemplo postado por este:
    Código:
    Private Sub Form_Timer()
    'Static strHora As Integer
    'Static strMinutos As Integer
    'Static strSegundos As Integer
    '
    '        If Trim(lblTempo.Caption) = "00:00:00" Then
    '            strHora = 0
    '            strMinutos = 0
    '            strSegundos = 0
    '        End If
    '
    '    strSegundos = strSegundos + 1
    '
    '        If strSegundos = 60 Then
    '            strSegundos = 0
    '            strMinutos = strMinutos + 1
    '        If strMinutos = 60 Then
    '            strMinutos = 0
    '            strHora = strHora + 1
    '        If strHora = 24 Then
    '        strHora = 0
    '      End If
    '    End If
    '  End If
    '
    '    lblTempo.Caption = Format(strHora, "00") & ":" & _
    '    Format(strMinutos, "00") & ":" & _
    '    Format(strSegundos, "00")
    ''TEMPO DE INATIVIDADE DO BANCO PARA ENCERRAMENTO SERÁ 10 MINUTOS
    'If lblTempo.Caption = "00:00:02" Then
    '    DoCmd.Quit acQuitSaveAll
    'End If

    '---------------------------------------------------------------------------
    'Este código se encontra no evento timer para alimentar a barra de progresso
    '---------------------------------------------------------------------------
    Evento = Evento + 1
            Dim strPathFile As String, strFile As String, strPath As String
            Dim strTable As String
            Dim blnHasFieldNames As Boolean
            blnHasFieldNames = True
            strPath = CurrentProject.Path & "\Importação\"
            strTable = "Tbl_Chamado_SAC"
            strFile = Dir(strPath & "Importação.xlsx")
            Do While Len(strFile) > 0
            strPathFile = strPath & strFile
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            strTable, strPathFile, blnHasFieldNames
            strFile = Dir()
            Loop

    Select Case Evento
        Case 1
            '-------------------------------------------------------------------------
            'Desabilita os botões enquanto a cópia estiver sendo realizada
            'Divide a barra de progresso, que tem um comprimento de 11cm, em 8 pedaços
            '-------------------------------------------------------------------------
            Me!cx1.Visible = True
            Me!btFoco.SetFocus
            Me!btImportação.Enabled = False
            Escala = (12.4 * 567) / 5
            Me!cx1.Width = Escala
        Case 2
            Me!Status.Caption = "Verificando Base de Dados..."
            Me!cx1.Width = Escala * 2
            DoEvents
        Case 3
            Me!Status.Caption = "Importando Base de Dados..."
            Me!cx1.Width = Escala * 3
            DoEvents
        Case 4
            '----------------------------------------------------------------------------
            'Inicia o processo de cópia simples da base de dados para o destino indicado.
            'Aqui a barra de progresso fica parada até a cópia ser concluída
            '----------------------------------------------------------------------------

        Case 5
            '----------------------------------------------
            'Após a conclusão da cópia o código prossegue
            '----------------------------------------------
            Me!Status.Caption = "Importação do Base de Dados Concluída..."
            Me!cx1.Width = Escala * 4
            DoEvents
        Case 6
            DoCmd.SetWarnings False
            DoCmd.OpenQuery ("Consulta_Atualizar_Concatenar_Grupo_e_Tipo_Manifestação"), acViewNormal, acEdit
            DoCmd.SetWarnings True
           
            DoCmd.SetWarnings False
            DoCmd.OpenQuery ("Consulta_Atualizar_Tipo_Manifestação"), acViewNormal, acEdit
            DoCmd.SetWarnings True
        Case 7
            Me!Status.Caption = "Classificando Chamados no Base de Dados..."
            Me!cx1.Width = Escala * 5
            DoEvents
            Me.TimerInterval = 0
            Evento = 0
    End Select
    sair:
        If Me.TimerInterval = 0 Then DoCmd.Close acDefault
        Exit Sub
    trataerro:
        MsgBox err.Number & " - " & err.Description, vbInformation, "Aviso"
        Evento = 0: Screen.MousePointer = 0: Me.TimerInterval = 0
        Resume sair

    End Sub

    Abraço

    Maurício Bruno
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 207
    Registrado : 25/05/2015

    [Resolvido]Barra de progresso em importação

    Mensagem  Maurício Bruno em Sex 23 Jun 2017, 19:38

    ahteixeira,

    Desculpe a demora no retorno.

    Funcionou demais o código.

    Muito obrigado pela ajuda e atenção.
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4402
    Registrado : 15/03/2013

    Re: [Resolvido]Barra de progresso em importação

    Mensagem  ahteixeira em Sab 24 Jun 2017, 09:48

    Olá Maurício, obrigado pelo retorno.
    O fórum agradece.
    Abraço

      Data/hora atual: Seg 25 Set 2017, 10:47