Esqueceu sua senha? Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

ListView Lento

Esclarecimentos e dúvidas sob o Modelo de Aplicativo de Cadastro em VBA no Microsoft Excel publicado no site e blog http://www.tomasvasquez.com.br
Diovanino Cassio
Colaborador
Colaborador
Mensagens: 44
Registrado em: Qua Mar 15, 2017 11:31 am

ListView Lento

Mensagem por Diovanino Cassio » Qui Abr 25, 2019 10:15 am

Senhores,

Quase todo o meu sistema, foi baseado no modelo de aplicativo de cadastro, onde pra todo o formulário de entrada de dados, possuo um formulário para pesquisa dos dados, usando LISTVIEW.
Acontece que agora, criei um formulário para controle de amostras que serão armazenadas, cuja base de dados (tabela do Excel), possui em torno de 1.517 registros (linhas), cujo tamanho está em 127KB, que razoavelmente é pequena.

Este meu formulário de pesquisa, está demorando mais de um minuto para mostrar estes 1.517 registros, que representam registro de 23 dias.

Estou preocupado, pois não tem nem um mês de arquivos gravados, e se continuar do jeito que está, vai inviabilizar este meu sistema.

Vou mostrar parte do meu código, principalmente a parte do PopulaListBox, que creio eu, que possa ser melhorado.

Código: Selecionar todos

Private Sub PopulaListBox(ByVal datalancini As String, _
                          ByVal datalancfin As String, _
                          ByVal datafatini As String, _
                          ByVal datafatfin As String, _
                          ByVal datadescini As String, _
                          ByVal datadescfin As String, _
                          ByVal etiqueta As String, _
                          ByVal lote As String, _
                          ByVal loteemb As String, _
                          ByVal prateleira As String, _
                          ByVal escaninho As String)

    On Error GoTo TrataErro

Dim rst As ADODB.Recordset
Dim campo As Field
Dim myArray() As Variant
Dim i As Integer
Dim li As ListItem, fld As Field, ch As ColumnHeader

Dim Column As Long
Dim Counter As Long
Counter = 0


Set rst = PreecheRecordSet(datalancini, datalancfin, datafatini, datafatfin, datadescini, datadescfin, etiqueta, lote, loteemb, prateleira, escaninho)

    

    'preenche o combobox com os nomes dos campos
    'persiste o índice
    Dim indiceTemp As Long
    indiceTemp = cboOrdenarPor.ListIndex
    cboOrdenarPor.Clear
    For Each campo In rst.Fields
        cboOrdenarPor.AddItem campo.Name
    Next
    'recupera o índice selecionado
    cboOrdenarPor.ListIndex = indiceTemp

    'Clear the Column Headers
    lstLista.ColumnHeaders.Clear
    'Clear all ListItems
    lstLista.ListItems.Clear

    'Colunas a Preencher Inicia na Primeira
    For i = 0 To rst.Fields.Count - 1 'For i = 1 : a partir da 2ª coluna
    'Esta linha adiciona novamente os cabeçalhos ao ListView
    Set ch = lstLista.ColumnHeaders.Add(, , rst.Fields(i).Name)
    'ch.Width = 48 'Define o Tamanho de Todas as COLUNAS
    'MsgBox rst.Fields(i).Name
    
    Next
 

    'coloca as linhas do RecordSet num Array, se houver linhas neste
    If Not rst.BOF Then
    Do While Not rst.EOF
        
                
         'Preenche o LISTVIEW a partir da 1ª Coluna
         Set li = lstLista.ListItems.Add(, "k" & rst.Fields(0), CheckNull(Format(rst.Fields(0), "000000")))
         
               'Fill in the rest of the columns
                For i = 1 To rst.Fields.Count - 1
                    li.SubItems(i) = CheckNull(rst.Fields(i))
                
                Next
                
                rst.MoveNext 'Move to next record
                Call NegritarColunas
             Loop
             
       
        
        
        'Define os Tamanhos das colunas automaticamente
        Call TamanhoColAutomatico
        
       End If
     'atualiza o label de mensagens
    If rst.RecordCount <= 0 Then
        lblMensagens.Caption = rst.RecordCount & " registros encontrados"
    Else
        lblMensagens.Caption = rst.RecordCount & " registros encontrados"
    End If
    
      
    Exit Sub

    ' Fecha o conjunto de registros.
    Set rst = Nothing
    ' Fecha a conexão.
    'conn.Close

TrataSaida:
    Exit Sub
TrataErro:
    Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
        MsgBox Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
    Resume TrataSaida
End Sub
Sds,
Diovanino Cássio



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1209
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Mensagem por Reinaldo » Qui Abr 25, 2019 11:14 am

Apenas pelo trecho disponibilizado, nada justifica o apontado, apenas chama atenção, e pode (ou não) influenciar em algum delay, e executar a rotina++>"Call NegritarColunas" <++ a cada registro incluído no listview;
bem como o " exit sub" antes da "limpeza" do recordset


Reinaldo
Gostou da resposta?:?: :oops: :D :mrgreen:

Diovanino Cassio
Colaborador
Colaborador
Mensagens: 44
Registrado em: Qua Mar 15, 2017 11:31 am

Re: ListView Lento (Resolvido)

Mensagem por Diovanino Cassio » Qui Abr 25, 2019 11:38 am

Valeu grande Reinaldo..!

A influência da lentidão estava mesmo na call NegritarColunas, pois estava antes do loop, ao invés de depois do loop.
Problema resolvido...!

Sds,



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder