Amigos, eu estava trabalhando com o Listview que é muito bom. O problema que em 64 bits não tem suporte.
Resolvi voltar para o Listbox. Agora tenho um pequeno problema: quero alinhar uma coluna para a direita (podemos utilizar a 3ª coluna)
Vou colocar abaixo o formulário Pesquisa (do site do tomas Vasquez) que é o normal e funciona bem (só não alinha a coluna à direita). fiz inúmeras consultas e encontrei uma dica super legal no site Clube do Hardware. Lá tem um exemplo, fiz e funciona para alinhamento à direita (usando fonte Courier). Só não tem o "filtro" de pesquisa. Então, juntando os dois (vou postar abaixo) teremos um ótimo resultado.
Alguém consegue me ajudar? Não consegui fazer, mas quem tem mais conhecimento nesta área poderá me ajudar e ficarei muitíssimo agradecido.
Pesquisa do Formulário (Exemplo do Tomas):
Option Explicit
'constantes para auxiliar na verificação do código
Private Const Ascendente As Byte = 0
Private Const Descendente As Byte = 1
Private Sub btnFiltrar_Click()
Call PopulaListBox(txtNomeEmpresa.Text, txtValor.Text, txtEndereco.Text, txtTelefone.Text, txtCidade.Text, txtBairro.Text)
End Sub
Private Sub CmdFechar_Click()
Unload Me
End Sub
Private Sub frmFiltros_Click()
End Sub
Private Sub lstLista_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If lstLista.ListIndex > 0 Then
Dim indiceRegistro As Long
indiceRegistro = frmCadastro.ProcuraIndiceRegistroPodId(lstLista.List(lstLista.ListIndex, 0))
If indiceRegistro <> -1 Then
Call frmCadastro.CarregaRegistroPorIndice(indiceRegistro)
End If
Unload Me
Else
lblMensagens.Caption = "É preciso selecionar um item válido na lista"
End If
End Sub
Private Sub UserForm_Initialize()
'preenche o cboDirecao e seleciona o primeiro item
cboDirecao.Clear
cboDirecao.AddItem "Ascendente"
cboDirecao.AddItem "Descendente"
cboDirecao.ListIndex = 0
Call PopulaListBox(vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString)
End Sub
Private Sub PopulaListBox(ByVal NomeEmpresa As String, _
ByVal CNPJ As String, _
ByVal Endereco As String, _
ByVal Telefone As String, _
ByVal Cidade As String, _
ByVal Bairro As String)
On Error GoTo TrataErro
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sql As String
Dim sqlWhere As String
Dim sqlOrderBy As String
Dim i As Integer
Dim campo As Field
Dim myArray() As Variant
Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.JET.OLEDB.4.0"
.ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;"
.Open
End With
sql = "SELECT * FROM [Clientes$]"
'monta a cláusula WHERE
'NomeDaEmpresa
Call MontaClausulaWhere(txtNomeEmpresa.Name, "NomeDaEmpresa", sqlWhere)
'CNPJ
Call MontaClausulaWhere(txtCNPJ.Name, "CNPJ", sqlWhere)
'Endereço
Call MontaClausulaWhere(txtEndereco.Name, "Endereço", sqlWhere)
'Cidade
Call MontaClausulaWhere(txtCidade.Name, "Cidade", sqlWhere)
'Telefone
Call MontaClausulaWhere(txtTelefone.Name, "Telefone", sqlWhere)
'Bairro
Call MontaClausulaWhere(txtBairro.Name, "Bairro", sqlWhere)
'faz a união da string SQL com a cláusula WHERE
If sqlWhere <> vbNullString Then
sql = sql & " WHERE " & sqlWhere
End If
'faz a união da string SQL com a cláusula ORDER BY
If cboOrdenarPor.ListIndex <> -1 Then
sqlOrderBy = " ORDER BY " & cboOrdenarPor.List(cboOrdenarPor.ListIndex, 0)
'define a direção
Select Case cboDirecao.ListIndex
Case Ascendente
sqlOrderBy = sqlOrderBy & " ASC"
Case Descendente
sqlOrderBy = sqlOrderBy & " DESC"
End Select
'une a query order ao sql
sql = sql & sqlOrderBy
End If
Set rst = New ADODB.Recordset
With rst
.ActiveConnection = conn
.Open sql, conn, adOpenDynamic, _
adLockBatchOptimistic
End With
'pega o número de registros para atribuí-lo ao listbox
lstLista.ColumnCount = rst.Fields.Count
'preenche o combobox com os nomes dos campos
'persiste o índice
lstLista.RowSource = "Clientes!A1:q250"
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
'coloca as linhas do RecordSet num Array, se houver linhas neste
If Not rst.EOF And Not rst.BOF Then
myArray = rst.GetRows
'troca linhas por colunas no Array
myArray = Array2DTranspose(myArray)
'atribui o Array ao listbox
lstLista.List = myArray
'adiciona a linha de cabeçalho da coluna
lstLista.AddItem , 0
'preenche o cabeçalho
For i = 0 To rst.Fields.Count - 1
lstLista.List(0, i) = rst.Fields(i).Name
Next i
'seleciona o primeiro item da lista
lstLista.ListIndex = 0
Else
lstLista.Clear
End If
'atualiza o label de mensagens
If lstLista.ListCount <= 0 Then
lblMensagens.Caption = lstLista.ListCount & " registros encontrados"
Else
lblMensagens.Caption = lstLista.ListCount - 1 & " registros encontrados"
End If
' 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
Resume TrataSaida
End Sub
Private Sub MontaClausulaWhere(ByVal NomeControle As String, ByVal NomeCampo As String, ByRef sqlWhere As String)
'CNPJ
If Trim(Me.Controls(NomeControle).Text) <> vbNullString Then
If sqlWhere <> vbNullString Then
sqlWhere = sqlWhere & " AND"
End If
sqlWhere = sqlWhere & " " & NomeCampo & " LIKE '%" & Trim(Me.Controls(NomeControle).Text) & "%'"
End If
End Sub
'Faz a transpasição de um array, transformando linhas em colunas
Private Function Array2DTranspose(avValues As Variant) As Variant
Dim lThisCol As Long, lThisRow As Long
Dim lUb2 As Long, lLb2 As Long
Dim lUb1 As Long, lLb1 As Long
Dim avTransposed As Variant
If IsArray(avValues) Then
On Error GoTo ErrFailed
lUb2 = UBound(avValues, 2)
lLb2 = LBound(avValues, 2)
lUb1 = UBound(avValues, 1)
lLb1 = LBound(avValues, 1)
ReDim avTransposed(lLb2 To lUb2, lLb1 To lUb1)
For lThisCol = lLb1 To lUb1
For lThisRow = lLb2 To lUb2
avTransposed(lThisRow, lThisCol) = avValues(lThisCol, lThisRow)
Next
Next
End If
Array2DTranspose = avTransposed
Exit Function
ErrFailed:
Debug.Print Err.Description
Debug.Assert False
Array2DTranspose = Empty
Exit Function
Resume
End Function
************************************************************************************************************
Exemplo do Clube do Hardware:
Parte do Formulário:
Private Sub UserForm_Activate()
'Ao clicar no botão que está na planilha
'é acessado o módulo onde o retorno da função Listando
'carrega o LstView.
Lstview.List = ModArrayList.Listando
End Sub
Parte do Módulo ModArrayList:
Function Listando()
Dim linhasPlan As Long
Dim matriz()
Dim lin As Long
Dim col As Integer
Dim valorStr As String
'Fazendo a leitura de quantas linhas de dados _
tenho na planilha ativa, a estando no módulo _
uma forma de mostrar qual é a planilha ativa _
é evocando o objeto que interessa, no caso do _
exemplo é "Plan1".
'Range("VT_DATA"), está relacionando na propriedade _
Range a coleção de células selecionadas e nomeadas _
com VT_DATA. Isso é feito na "caixa de nome" ao lado _
da "caixa de formulas" [fx]. Isso assegura ter a contagem _
de linhas corretas, pois certamente toda descrição de _
duplicata terá uma data.
linhasPlan = WorksheetFunction.CountA(Sheets("plan1").Range("VT_DATA"))
'agora temos condição de redimensionarmos a matriz
ReDim matriz(lin To linhasPlan, col To 3)
'limpa o objeto ListBox
FrmLista.Lstview.Clear
'limpando a matriz
For i = 0 To linhasPlan
For j = 0 To 2
matriz(i, j) = Empty
Next j
Next i
'Montando o cabeçalho
matriz(0, 0) = "DATA"
matriz(0, 1) = "DESCRIÇÃO"
matriz(0, 2) = "VALOR EM R$"
'acrescentando os dados da Worksheet na matriz
For i = 1 To linhasPlan
For j = 0 To 2
If j = 2 Then 'coluna de valores
'O Valor é convertido para String que formatado
'a variável valorStr recebe o Valor ajustado com
'a função Space onde tenho uma expressão que
'verifica com a função Len o tamanho da String
'menos 10 caracteres sugeridos, assim completa
'com espaços em branco a frente do valor alinhando
'todos os valores a direita.
valorStr = Format(CStr(Sheets("plan1").Cells(i + 1, j + 1)), "###,##0.00")
matriz(i, j) = Space(10 - Len(valorStr)) & valorStr
Else
matriz(i, j) = Sheets("plan1").Cells(i + 1, j + 1)
End If
Next j
Next i
Listando = matriz
End Function