Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Pesquisa listview cabecalho.

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
kaiocezar
Colaborador
Colaborador
Mensagens: 20
Registrado em: Qua Mar 21, 2012 12:29 pm

Pesquisa listview cabecalho.

Mensagem por kaiocezar »

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


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
joseA
Jedi
Jedi
Mensagens: 1048
Registrado em: Qui Out 22, 2009 7:22 am
Localização: Cel. Fabriciano - MG

Re: Pesquisa listview cabecalho.

Mensagem por joseA »

Antes do preenchimento coloque:

Código: Selecionar todos

    Me.ListView1.ColumnHeaders.Clear


kaiocezar
Colaborador
Colaborador
Mensagens: 20
Registrado em: Qua Mar 21, 2012 12:29 pm

Re: Pesquisa listview cabecalho.

Mensagem por kaiocezar »

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


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


Avatar do usuário
joseA
Jedi
Jedi
Mensagens: 1048
Registrado em: Qui Out 22, 2009 7:22 am
Localização: Cel. Fabriciano - MG

Re: Pesquisa listview cabecalho.

Mensagem por joseA »

Olá Kaio,

Verifiquei seu procedimento e encontrei essa linha

Código: Selecionar todos

'Clear the Column Headers
 lstLista.ListItems.Clear
com o comentário de limpeza das colunas, no entanto sem o procedimento, copie/cole ali. ;)


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.


kaiocezar
Colaborador
Colaborador
Mensagens: 20
Registrado em: Qua Mar 21, 2012 12:29 pm

Re: Pesquisa listview cabecalho.

Mensagem por kaiocezar »

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!


kaiocezar
Colaborador
Colaborador
Mensagens: 20
Registrado em: Qua Mar 21, 2012 12:29 pm

Re: Pesquisa listview cabecalho.

Mensagem por kaiocezar »

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


Avatar do usuário
joseA
Jedi
Jedi
Mensagens: 1048
Registrado em: Qui Out 22, 2009 7:22 am
Localização: Cel. Fabriciano - MG

Re: Pesquisa listview cabecalho.

Mensagem por joseA »

E aí Kaio,

O especialista nesse modelo com ListView é o nosso Mauro, anda sumido o rapaz. Sem fazer promessas, posta o seu modelo. ;)


Avatar do usuário
Mikel Silveira Fraga
Jedi
Jedi
Mensagens: 1173
Registrado em: Sex Mai 27, 2011 3:27 pm
Localização: Governador Valadares - MG
Contato:

Re: Pesquisa listview cabecalho.

Mensagem por Mikel Silveira Fraga »

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.

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
2º Passo:

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
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.


kaiocezar
Colaborador
Colaborador
Mensagens: 20
Registrado em: Qua Mar 21, 2012 12:29 pm

Re: Pesquisa listview cabecalho.

Mensagem por kaiocezar »

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!
Anexos
MdC_FrontEnd ListView.zip
(53.79 KiB) Baixado 545 vezes
ModeloCadastro_Dados.zip
(105.97 KiB) Baixado 516 vezes


Avatar do usuário
joseA
Jedi
Jedi
Mensagens: 1048
Registrado em: Qui Out 22, 2009 7:22 am
Localização: Cel. Fabriciano - MG

Re: Pesquisa listview cabecalho.

Mensagem por joseA »

Olá Kaio,

Procure pela:

Código: Selecionar todos

Private Sub PopulaListBox
e dentro dessa "Sub" insira, acima da linha que preenche o cabeçalho, o procedimento que limpará o cabeçalho, ficará assim:

Código: Selecionar todos

Me.lstLista.ColumnHeaders.Clear
Set rst = PreecheRecordSet(NomeEmpresa, NomeContato, Endereco, Telefone, Regiao)


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