Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Pesquisa listview cabecalho.
Pesquisa listview cabecalho.
Bom dia amigos,
estou utilizando o modelo oferecido no site do Tomas Vasquez e adaptando a minha necessidade, porem estou agora com um problema nao muito grande porem ate o momento sem solucao. Obs: nao possuo muito conhecimento em VBA, por isso a solucao desse problema pode ser muito facil.
O problema e o seguinte:
no formulario de pesquisa, quanto clico em filtrar algum dos valores nos textbox o listview apresenta o valor desejado, porem esse comando de filtrar esta duplicando os cabacalhos da minha tabela, ou seja, quando clico em filtrar o programa faz a filtragem corretamente porem ela duplica os cabecalhos, e a cada clique no botao filtrao, mais uma leva dos cabecalhos sao criados nos listview.
O resultado da pesquisa fica mais ou menos assim:
Codigo Fornecedor - Empresa - Rua - Cidade - Cep - Codigo Fornecedor - Empresa - Rua - Cidade - Cep
5 X X X X
Ou seja, os novos cabecalhos sao criados a mais, e nao tem utilidade nenhuma! Gostraria de pedir uma ajuda na solucao desse problema!!
Desde Ja obrigado pela atencao!!!
Kaio Cezar
estou utilizando o modelo oferecido no site do Tomas Vasquez e adaptando a minha necessidade, porem estou agora com um problema nao muito grande porem ate o momento sem solucao. Obs: nao possuo muito conhecimento em VBA, por isso a solucao desse problema pode ser muito facil.
O problema e o seguinte:
no formulario de pesquisa, quanto clico em filtrar algum dos valores nos textbox o listview apresenta o valor desejado, porem esse comando de filtrar esta duplicando os cabacalhos da minha tabela, ou seja, quando clico em filtrar o programa faz a filtragem corretamente porem ela duplica os cabecalhos, e a cada clique no botao filtrao, mais uma leva dos cabecalhos sao criados nos listview.
O resultado da pesquisa fica mais ou menos assim:
Codigo Fornecedor - Empresa - Rua - Cidade - Cep - Codigo Fornecedor - Empresa - Rua - Cidade - Cep
5 X X X X
Ou seja, os novos cabecalhos sao criados a mais, e nao tem utilidade nenhuma! Gostraria de pedir uma ajuda na solucao desse problema!!
Desde Ja obrigado pela atencao!!!
Kaio Cezar
- joseA
- Jedi
- Mensagens: 1048
- Registrado em: Qui Out 22, 2009 7:22 am
- Localização: Cel. Fabriciano - MG
Re: Pesquisa listview cabecalho.
Antes do preenchimento coloque:
Código: Selecionar todos
Me.ListView1.ColumnHeaders.Clear
Re: Pesquisa listview cabecalho.
Primeiramente obrigado joseA pela resposta, porem ja tentei colocar a sua sugestao no codigo do meu formulario de pesquisa porem nao funcionou, talves eu esteja colocando em um lugar errado! Segue abaixo o codigo do meu formulario de pesquisa!
Obs: ja mudei
Me.ListView1.ColumnHeaders.Clear
para
Me.lstLista.ColumnHeaders.Clear, que eh o nome da minha listview!
Desde ja agradeco pela sua resposta!
Kaio Barbanti
Obs: ja mudei
Me.ListView1.ColumnHeaders.Clear
para
Me.lstLista.ColumnHeaders.Clear, que eh o nome da minha listview!
Desde ja agradeco pela sua resposta!
Kaio Barbanti
Código: Selecionar todos
Option Explicit
'constantes para auxiliar na verificação do código
Private Const Ascendente As Byte = 0
Private Const Descendente As Byte = 1
Private caminhoArquivoDados As String
'INICIO - REDIMENSIONAR AUTOMATICAMENTE COLUNAS DO LISTVIEW
'TamanhoColAutomatico - 'Define os Tamanhos das colunas automaticamente
'http://www.vb6.com.br/29/Controles-Microsoft/visual-basic-REDIMENSIONAR-AUTOMATICAMENTE-COLUNAS-DO-LISTVIEW.html
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const LVM_FIRST = &H1000
Private Const LVM_SETCOLUMNWIDTH = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE = -1
Private Const LVSCW_AUTOSIZE_USEHEADER = -2
'FIM - REDIMENSIONAR AUTOMATICAMENTE COLUNAS DO LISTVIEW
Private Sub btnExportar_Click()
Call Exportar
End Sub
Private Sub btnFiltrar_Click()
Call PopulaListBox(txtNomeEmpresa.Text, txtNomeContato.Text, txtEndereco.Text, txtTelefone.Text, txtRegiao.Text, TextBox1.Text, TextBox2.Text, TextBox3.Text, TextBox4.Text, TextBox5.Text, TextBox6.Text, TextBox7.Text, TextBox8.Text, TextBox9.Text, TextBox10.Text, TextBox11.Text)
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
TextBox1.Text = "Ja"
Else
TextBox1.Text = ""
End If
End Sub
Private Sub CheckBox10_Click()
If CheckBox10.Value = True Then
TextBox10.Text = "Ja"
Else
TextBox10.Text = ""
End If
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
TextBox2.Text = "Ja"
Else
TextBox2.Text = ""
End If
End Sub
Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then
TextBox3.Text = "Ja"
Else
TextBox3.Text = ""
End If
End Sub
Private Sub CheckBox4_Click()
If CheckBox4.Value = True Then
TextBox4.Text = "Ja"
Else
TextBox4.Text = ""
End If
End Sub
Private Sub CheckBox5_Click()
If CheckBox5.Value = True Then
TextBox5.Text = "Ja"
Else
TextBox5.Text = ""
End If
End Sub
Private Sub CheckBox6_Click()
If CheckBox6.Value = True Then
TextBox6.Text = "Ja"
Else
TextBox6.Text = ""
End If
End Sub
Private Sub CheckBox7_Click()
If CheckBox7.Value = True Then
TextBox7.Text = "Ja"
Else
TextBox7.Text = ""
End If
End Sub
Private Sub CheckBox8_Click()
If CheckBox8.Value = True Then
TextBox8.Text = "Ja"
Else
TextBox8.Text = ""
End If
End Sub
Private Sub CheckBox9_Click()
If CheckBox9.Value = True Then
TextBox9.Text = "Ja"
Else
TextBox9.Text = ""
End If
End Sub
Private Sub frmFiltros_Click()
End Sub
Private Sub lstLista_DblClick()
Dim linha, Index
Dim i As Integer
Dim oList As Object
Dim indiceRegistro As Long
On Error Resume Next
Set oList = lstLista.SelectedItem
If oList Is Nothing Then 'Exit Sub
lblMensagens.Caption = ""
Else
indiceRegistro = frmCadastro.ProcuraIndiceRegistroPodId(lstLista.ListItems.Item(lstLista.SelectedItem.Index))
If indiceRegistro <> -1 Then
Call frmCadastro.CarregaRegistroPorIndice(indiceRegistro)
End If
End If
frmCadastro.Show
End Sub
Private Sub DefinePlanilhaDados()
Dim wb As Workbook
Dim caminhoCompleto As String
Dim ARQUIVO_DADOS As String
Dim PASTA_DADOS As String
ThisWorkbook.Activate
ARQUIVO_DADOS = Range("ARQUIVO_DADOS").Value
PASTA_DADOS = Range("PASTA_DADOS").Value
If ThisWorkbook.Name <> ARQUIVO_DADOS Then
'monta a string do caminho completo
If PASTA_DADOS = vbNullString Or PASTA_DADOS = "" Then
caminhoCompleto = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & ARQUIVO_DADOS
Else
If Right(PASTA_DADOS, 1) = "\" Then
caminhoCompleto = PASTA_DADOS & ARQUIVO_DADOS
Else
caminhoCompleto = PASTA_DADOS & "\" & ARQUIVO_DADOS
End If
End If
End If
caminhoArquivoDados = caminhoCompleto
End Sub
Private Sub txtNomeContato_Change()
End Sub
Private Sub UserForm_Initialize()
'lv.ListItems.Clear 'Clear ListView from previous filled data
lstLista.ColumnHeaders.Clear 'Clear the Column Headers
lstLista.ListItems.Clear
With lstLista
.Gridlines = True
.View = lvwReport
' .FullRowSelect
.ColumnHeaders.Add Text:="Code", Width:=20
.ColumnHeaders.Add Text:="Firma", Width:=100
'.ColumnHeaders.Add Text:="Endereço", Width:=120
'.ColumnHeaders.Add Text:="FONE", Width:=30
'.ColumnHeaders.Add Text:="CIDADE", Width:=50
End With
'preenche o cboDirecao e seleciona o primeiro item
cboDirecao.Clear
cboDirecao.AddItem "Ascendente"
cboDirecao.AddItem "Descendente"
cboDirecao.ListIndex = 0
Call DefinePlanilhaDados
Call PopulaCidades
Call PopulaListBox(vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString)
End Sub
Private Sub Exportar()
Dim i As Integer
Dim NewWorkBook As Workbook
Dim rst As ADODB.Recordset
' Preenche o RecordSet com os filtros atuais
Set rst = PreecheRecordSet(txtNomeEmpresa.Text, txtNomeContato.Text, txtEndereco.Text, txtTelefone.Text, txtRegiao.Text, TextBox1.Text, TextBox2.Text, TextBox3.Text, TextBox4.Text, TextBox5.Text, TextBox6.Text, TextBox7.Text, TextBox8.Text, TextBox9.Text, TextBox10.Text, TextBox11.Text)
'cria um novo Workbook
Set NewWorkBook = Application.Workbooks.Add
' Efetua loop em todos os campos, retornando os nomes de campos
' à planilha.
For i = 0 To rst.Fields.Count - 1
NewWorkBook.Sheets(1).Range("A1").Offset(0, i).Value = rst.Fields(i).Name
Next i
NewWorkBook.Sheets(1).Range("A2").CopyFromRecordset rst
NewWorkBook.Activate
End Sub
Private Sub PopulaCidades()
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sql As String
Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.JET.OLEDB.4.0"
.ConnectionString = "Data Source=" & caminhoArquivoDados & ";Extended Properties=Excel 8.0;"
.Open
End With
sql = "SELECT DISTINCT Cidade FROM [Fornecedores$]"
Set rst = New ADODB.Recordset
With rst
.ActiveConnection = conn
.Open sql, conn, adOpenDynamic, _
adLockBatchOptimistic
End With
Do While Not rst.EOF
If Not IsNull(rst(0).Value) Then
lstCidades.AddItem rst(0).Value
End If
rst.MoveNext
Loop
' Fecha o conjunto de registros.
Set rst = Nothing
' Fecha a conexão.
conn.Close
End Sub
Private Sub PopulaListBox(ByVal NomeEmpresa As String, _
ByVal NomeContato As String, _
ByVal Endereco As String, _
ByVal Telefone As String, _
ByVal Regiao As String, _
ByVal equip As String, _
ByVal Sattelauflieger As String, _
ByVal Megatrailer As String, _
ByVal Gliederzug As String, _
ByVal Maxx As String, _
ByVal Coilmulde As String, _
ByVal Schwertransporter As String, _
ByVal ISO As String, _
ByVal guttransporte As String, _
ByVal Luftfracht As String, _
ByVal Land 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(NomeEmpresa, NomeContato, Endereco, Telefone, Regiao, equip, Sattelauflieger, Megatrailer, Gliederzug, Maxx, Coilmulde, Schwertransporter, ISO, guttransporte, Luftfracht, Land)
'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
'Colunas a Preencher Inicia na Primeira
For i = 2 To rst.Fields.Count - 101 'For i = 1 : a partir da 2ª coluna
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
'Clear the Column Headers
lstLista.ListItems.Clear
'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 2ª Coluna
'Set li = lstLista.ListItems.Add(, "k" & rst.Fields(0), CheckNull(rst.Fields(1)))
'Fill in the rest of the columns
'For i = 2 To rst.Fields.Count - 1
'li.SubItems(i - 1) = CheckNull(rst.Fields(i))
'Preenche o LISTVIEW a partir da 1ª Coluna
Set li = lstLista.ListItems.Add(, "k" & rst.Fields(0), CheckNull(rst.Fields(0)))
'Fill in the rest of the columns
For i = 1 To rst.Fields.Count - 101
li.SubItems(i) = CheckNull(rst.Fields(i))
Next
rst.MoveNext 'Move to next record
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 & " Lieferant gefunden"
Else
lblMensagens.Caption = rst.RecordCount & " Lieferanten gefunden"
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
Private Sub TamanhoColAutomatico()
Dim Column As Long
Dim Counter As Long
Counter = 0
For Column = Counter To lstLista.ColumnHeaders.Count - 2
SendMessage lstLista.hWnd, LVM_SETCOLUMNWIDTH, Column, LVSCW_AUTOSIZE_USEHEADER
Next
End Sub
Public Function CheckNull(FieldValue As Variant)
On Error GoTo Error
If IsNull(FieldValue) Then
CheckNull = ""
Else
CheckNull = FieldValue
End If
' Exit Sub
Error:
'GeneralErrors "CheckNull", Err.Number, Err.Description
Resume Next
End Function
Private Function PreecheRecordSet(ByVal NomeEmpresa As String, _
ByVal NomeContato As String, _
ByVal Endereco As String, _
ByVal Telefone As String, _
ByVal Regiao As String, _
ByVal equip As String, _
ByVal Sattelauflieger As String, _
ByVal Megatrailer As String, _
ByVal Gliederzug As String, _
ByVal Maxx As String, _
ByVal Coilmulde As String, _
ByVal Schwertransporter As String, _
ByVal ISO As String, _
ByVal guttransporte As String, _
ByVal Luftfracht As String, _
ByVal Land As String) As Recordset
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=" & caminhoArquivoDados & ";Extended Properties=Excel 8.0;"
.Open
End With
sql = "SELECT * FROM [Fornecedores$]"
'monta a cláusula WHERE
'Firma
Call MontaClausulaWhere(txtNomeEmpresa.Name, "Firma", sqlWhere)
'Straße
Call MontaClausulaWhere(txtEndereco.Name, "Straße", sqlWhere)
'PLZ
Call MontaClausulaWhere(txtNomeContato.Name, "PLZ", sqlWhere)
'Cidade
For i = 1 To lstCidades.ListCount
'verifica se o item está selecionado
If lstCidades.Selected(i - 1) Then
'Monta a cláusula WHERE com OR
Debug.Print lstCidades.List(i - 1) & " selecionado"
If sqlWhere <> vbNullString Then
sqlWhere = sqlWhere & " OR"
End If
sqlWhere = sqlWhere & " UCASE(Cidade) LIKE UCASE('%" & Trim(lstCidades.List(i - 1)) & "%')"
End If
Next
'Anrede
Call MontaClausulaWhere(txtTelefone.Name, "Anrede", sqlWhere)
'Website
Call MontaClausulaWhere(txtRegiao.Name, "Website", sqlWhere)
'Equip
Call MontaClausulaWhere(TextBox1.Name, "equip", sqlWhere)
'Sattelauflieger
Call MontaClausulaWhere(TextBox2.Name, "Sattelauflieger", sqlWhere)
'Megatrailer
Call MontaClausulaWhere(TextBox3.Name, "Megatrailer", sqlWhere)
'Gliederzug
Call MontaClausulaWhere(TextBox4.Name, "Gliederzug", sqlWhere)
'Maxx
Call MontaClausulaWhere(TextBox5.Name, "Maxx", sqlWhere)
'Coilmulde
Call MontaClausulaWhere(TextBox6.Name, "Coilmulde", sqlWhere)
'Schwertransporter
Call MontaClausulaWhere(TextBox7.Name, "Schwertransporter", sqlWhere)
'ISO
Call MontaClausulaWhere(TextBox8.Name, "ISO", sqlWhere)
'guttransporte
Call MontaClausulaWhere(TextBox9.Name, "guttransporte", sqlWhere)
'Luftfracht
Call MontaClausulaWhere(TextBox10.Name, "Luftfracht", sqlWhere)
'Land
Call MontaClausulaWhere(TextBox11.Name, "Land", 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
rst.CursorLocation = adUseClient
With rst
.ActiveConnection = conn
.Open sql, conn, adOpenForwardOnly, _
adLockBatchOptimistic
End With
Set rst.ActiveConnection = Nothing
' Fecha a conexão.
conn.Close
Set PreecheRecordSet = rst
Exit Function
TrataErro:
Set rst = Nothing
End Function
Private Sub MontaClausulaWhere(ByVal NomeControle As String, ByVal NomeCampo As String, ByRef sqlWhere As String)
'NomeDoContato
If Trim(Me.Controls(NomeControle).Text) <> vbNullString Then
If sqlWhere <> vbNullString Then
sqlWhere = sqlWhere & " AND"
End If
sqlWhere = sqlWhere & " UCASE(" & NomeCampo & ") LIKE UCASE('%" & 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
- joseA
- Jedi
- Mensagens: 1048
- Registrado em: Qui Out 22, 2009 7:22 am
- Localização: Cel. Fabriciano - MG
Re: Pesquisa listview cabecalho.
Olá Kaio,
Verifiquei seu procedimento e encontrei essa linha com o comentário de limpeza das colunas, no entanto sem o procedimento, copie/cole ali.
Verifiquei seu procedimento e encontrei essa linha
Código: Selecionar todos
'Clear the Column Headers
lstLista.ListItems.Clear
Re: Pesquisa listview cabecalho.
Ola joseA, mais uma vez obrigao pela ajuda, porem quando coloco "Me.lstLista.ColumnHeaders.Clear" naquela regiao onde voce indicou o seguinte erro me aparece quando rodo o programa:
"Invalid property value 380 ListItem"
e assim minha Listview fica completamente em branco e o recurso de filtrar nao funciona mais, o erro se repete qunado tento filtrar!
Se voce puder me ajudar eu agradeceria!
Kaio Cezar!
"Invalid property value 380 ListItem"
e assim minha Listview fica completamente em branco e o recurso de filtrar nao funciona mais, o erro se repete qunado tento filtrar!
Se voce puder me ajudar eu agradeceria!
Kaio Cezar!
Re: Pesquisa listview cabecalho.
Ola pessoal do forum!
Alguem sabe qual seria o significado desse erro?
"Invalid property value 380 ListItem"
Meu problema ainda persiste, ja tentei colocar o comando de limpar os titulos das colunos porem nao funciona corretamente, na maioria da vez o programa me retorna esse erro e quando nao me retorna o erro me retorna com a minha listview completamente em branco!!
Alguma ideia?
DEsde ja agradeco a ajuda, esse forum eh realmente especial!
Kaio Barbanti
Alguem sabe qual seria o significado desse erro?
"Invalid property value 380 ListItem"
Meu problema ainda persiste, ja tentei colocar o comando de limpar os titulos das colunos porem nao funciona corretamente, na maioria da vez o programa me retorna esse erro e quando nao me retorna o erro me retorna com a minha listview completamente em branco!!
Alguma ideia?
DEsde ja agradeco a ajuda, esse forum eh realmente especial!
Kaio Barbanti
- joseA
- Jedi
- Mensagens: 1048
- Registrado em: Qui Out 22, 2009 7:22 am
- Localização: Cel. Fabriciano - MG
Re: Pesquisa listview cabecalho.
E aí Kaio,
O especialista nesse modelo com ListView é o nosso Mauro, anda sumido o rapaz. Sem fazer promessas, posta o seu modelo.
O especialista nesse modelo com ListView é o nosso Mauro, anda sumido o rapaz. Sem fazer promessas, posta o seu modelo.
- Mikel Silveira Fraga
- Jedi
- Mensagens: 1173
- Registrado em: Sex Mai 27, 2011 3:27 pm
- Localização: Governador Valadares - MG
- Contato:
Re: Pesquisa listview cabecalho.
Kaio, bom dia.
Cara, estive observando alguns modelos do forum que utilizam o ListView e eu não uso da mesma forma que os demais, então vou lhe passar uma dica de como utilizo e veja se ajuda.
1º Passo:
No formulário onde o ListView se encontra, coloque essa sequencia de comando em um Metodo Active ou Initialize.
2º Passo:
No botão que faz a pesquisa, você pode realizar o seguinte código:
Este código é utilizado para preencher um ListView com informações buscadas em um BD MySQL, mas o padrão de uso também serve para o uso de Excel ou Access.
Veja se por acaso esse modelo de código ajuda a resolver o seu problema.
Caso não de certo, seria interessante fazer como disse o nosso amigo joseA, envie o modelo para que possamos analisar, dessa forma fica mais fácil.
Abraços e boa sorte.
Cara, estive observando alguns modelos do forum que utilizam o ListView e eu não uso da mesma forma que os demais, então vou lhe passar uma dica de como utilizo e veja se ajuda.
1º Passo:
No formulário onde o ListView se encontra, coloque essa sequencia de comando em um Metodo Active ou Initialize.
Código: Selecionar todos
With Me.ListView1
.ColumnHeaders.Clear
.ListItems.Clear
.FullRowSelect = True
.Gridlines = True
.View = lvwReport
.ColumnHeaders.Add Text:="Código", Width:=40
.ColumnHeaders.Add Text:="Razão Social", Width:=150
.ColumnHeaders.Add Text:="CNPJ / CPF", Width:=120
.ColumnHeaders.Add Text:="Dt. Cadastro", Width:=70
.ColumnHeaders.Add Text:="Estado", Width:=40
End With
No botão que faz a pesquisa, você pode realizar o seguinte código:
Código: Selecionar todos
With Me.ListView1
.ListItems.Clear
.FullRowSelect = True
Do Until tabela(0).EOF
.ListItems.Add 1, , tabela(0)("EMP_ID")
.ListItems(1).ListSubItems.Add 1, , tabela(0)("EMP_RAZAOSOCIAL")
If tabela(0)("EMP_CNPJ") <> "00.000.000/0000-00" Then
.ListItems(1).ListSubItems.Add 2, , tabela(0)("EMP_CNPJ")
ElseIf tabela(0)("EMP_CPF") <> "000.000.000-00" Then
.ListItems(1).ListSubItems.Add 2, , tabela(0)("EMP_CPF")
End If
.ListItems(1).ListSubItems.Add 3, , VBA.Format(tabela(0)("EMP_DTCADASTRO"), "dd/mm/yyyy")
.ListItems(1).ListSubItems.Add 4, , tabela(0)("EMP_UF")
tabela(0).MoveNext
Loop
End With
Veja se por acaso esse modelo de código ajuda a resolver o seu problema.
Caso não de certo, seria interessante fazer como disse o nosso amigo joseA, envie o modelo para que possamos analisar, dessa forma fica mais fácil.
Abraços e boa sorte.
Re: Pesquisa listview cabecalho.
Ola amigos do forum,
primeiramente gostaria de agradecar ao Mikel e ao joseA pelas resposta, porem ainda nao consegui solucionar o problema! Talvez eu nao tenha explicado direito o problema, por isso estou enviando o arquivo em anexo!
Recapitulando o problema:
Toda vez que eu clico em filtrar no formulario de pesquisa, o programa cria uma nova sequencia de cabecalhos! O funcionamento do programa esta correto, ele procurar as informacoes que eu quero e joga corretamente na Listview, porem vai criando na Listview novos cabecalhos. A listview vai crescendo para a direita!!^
Agradeco desde ja qualquer forma de ajuda!
Obrigado a todos!
Kaio Cezar!
primeiramente gostaria de agradecar ao Mikel e ao joseA pelas resposta, porem ainda nao consegui solucionar o problema! Talvez eu nao tenha explicado direito o problema, por isso estou enviando o arquivo em anexo!
Recapitulando o problema:
Toda vez que eu clico em filtrar no formulario de pesquisa, o programa cria uma nova sequencia de cabecalhos! O funcionamento do programa esta correto, ele procurar as informacoes que eu quero e joga corretamente na Listview, porem vai criando na Listview novos cabecalhos. A listview vai crescendo para a direita!!^
Agradeco desde ja qualquer forma de ajuda!
Obrigado a todos!
Kaio Cezar!
- Anexos
-
- MdC_FrontEnd ListView.zip
- (53.79 KiB) Baixado 566 vezes
-
- ModeloCadastro_Dados.zip
- (105.97 KiB) Baixado 536 vezes
- joseA
- Jedi
- Mensagens: 1048
- Registrado em: Qui Out 22, 2009 7:22 am
- Localização: Cel. Fabriciano - MG
Re: Pesquisa listview cabecalho.
Olá Kaio,
Procure pela: e dentro dessa "Sub" insira, acima da linha que preenche o cabeçalho, o procedimento que limpará o cabeçalho, ficará assim:
Procure pela:
Código: Selecionar todos
Private Sub PopulaListBox
Código: Selecionar todos
Me.lstLista.ColumnHeaders.Clear
Set rst = PreecheRecordSet(NomeEmpresa, NomeContato, Endereco, Telefone, Regiao)