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
Diovanino Cássio