PreencherListViewSimplificado

[joseA]

Olá,

Adaptando uma função do Tomás foi possivel encontrar um preenchimento do cabeçalho e ajuste das colunas, conforme dados da plan, em um controle ListView, bastante simplificado. Faça o teste:

Código: Selecionar todos

Private Sub PreencherCabeçalho()
'Desenvolvida por: Tomás Vásquez
'Adaptada por: José Arnaldo

    Dim ws As Worksheet
    Dim coluna As Integer
    Dim linha As Integer
    Set ws = Plan1
    coluna = 1
    linha = 1
    
    With ws
        While .Cells(linha, coluna).Value <> Empty
               With ListView1
                 .View = lvwReport
                 .Gridlines = True
                 .ColumnHeaders.Add Text:=ws.Cells(linha, coluna), Width:=ws.Cells(linha, coluna).Width
               End With
            coluna = coluna + 1
        Wend
    End With
End Sub

Faltou um preenchimento simplificado para as linhas. Alguma sugestão??

[Mauro Coutinho]

José aproveitando uma outra rotina a qual postarei em outro tópico, para preenchermos as linhas tambem a mesma ficaria assim :

Código: Selecionar todos

    Private Sub PreencherCabeçalho()
    'Desenvolvida por: Tomás Vásquez
    'Adaptada por: José Arnaldo
        Dim ws As Worksheet
        Dim coluna As Integer
        Dim linha As Integer
        Set ws = Plan1
        coluna = 1
        linha = 1
        
    Dim itm As ListItem, n As Long, lngCol As Long
    Dim vardata As Variant
    
    vardata = Range("A1").CurrentRegion.Value
        
        With ws
            While .Cells(linha, coluna).Value <> Empty
                   With ListView1
                     .View = lvwReport
                     .Gridlines = True
                     .ColumnHeaders.Add Text:=ws.Cells(linha, coluna), Width:=ws.Cells(linha, coluna).Width
                   
                   'Preenche as Linhas
                    For n = 2 To UBound(vardata)
                        Set itm = .ListItems.Add(n - 1, , vardata(n, 1))
                        For lngCol = 2 To UBound(vardata, 2)
                            itm.ListSubItems.Add , , vardata(n, lngCol)
                        Next lngCol
                    Next n
                   
                   End With
                coluna = coluna + 1
            Wend
        End With

    End Sub

Era isto que se referiu ?

Faltou um preenchimento simplificado para as linhas. Alguma sugestão??

[]s

[Mauro Coutinho]

Uma outra forma de preenchermos o Cabeçalho do ListView e as Linhas, seria com as s rotinas abaixo, infelizmente não tenho o autor, se alguem souber, favor colocar os creditos :

Código: Selecionar todos

Private Sub UserForm_Initialize()
    Dim itm As ListItem, n As Long, lngCol As Long
    Dim vardata As Variant
    
        vardata = Range("A1").CurrentRegion.Value
       
    With Me.ListView1
        .ColumnHeaders.Clear
            
            For n = 1 To UBound(vardata, 2)
                .ColumnHeaders.Add n, , vardata(1, n), 50
            Next n
            
            .HideColumnHeaders = False
            .View = lvwReport
            .Gridlines = True
    
            For n = 2 To UBound(vardata)
                
                Set itm = .ListItems.Add(n - 1, , vardata(n, 1))
            
                For lngCol = 2 To UBound(vardata, 2)
                    itm.ListSubItems.Add , , vardata(n, lngCol)
                Next lngCol
            
            Next n
            
    End With
    
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

    'Ordenar pela Coluna Clicada
     With ListView1
        If .SortKey = ColumnHeader.Index - 1 Then
           If .SortOrder = lvwAscending Then
              .SortOrder = lvwDescending
           Else
              .SortOrder = lvwAscending
           End If
        Else
           .SortKey = ColumnHeader.Index - 1
        End If
         .Sorted = True
    End With
  
End Sub

{]s

[joseA]

Grande Mauro, Bom dia!!

No 2º procedimento funcionou beleza, deu até para adaptar o ajuste de colunas. Agora, no 1º adaptado os dados repetem.

Veja em um pequeno exemplo para demosntração.

Obs.: O arquivo com erro foi substituido, esse aí rola redondo.

[Mauro Coutinho]

José, não tinha reparado qdo fiz o teste, mas acredito é só questão de adaptação, depois verifico melhor, por hora podemos ajustar a não repetição, mudando as instruções que preenchem a linha de lugar :

Código: Selecionar todos

    Private Sub PreencherCabeçalhoLinhas()
    'Desenvolvida por: Tomás Vásquez
    'Adaptada por: José Arnaldo
    'Implementado por: Mauro Coutinho
    
        Dim ws As Worksheet
        Dim coluna As Integer
        Dim linha As Integer
        Set ws = ThisWorkbook.Worksheets(NomePlanilha)
        coluna = 1
        linha = LinhaCabecalho
        
    Me.ListView1.ListItems.Clear
    Me.ListView1.ColumnHeaders.Clear
    
    Dim itm As ListItem, n As Long, lngCol As Long
    Dim vardata As Variant
    
    vardata = Range("A1").CurrentRegion.Value
        
        With ws
            While .Cells(linha, coluna).Value <> Empty
                   With ListView1
                     .View = lvwReport
                     .Gridlines = True
                     .ColumnHeaders.Add Text:=ws.Cells(linha, coluna), Width:=ws.Cells(linha, coluna).Width
                   
                   End With
                coluna = coluna + 1
            Wend
            
            'Preenche as Linhas
            With ListView1
                    For n = 2 To UBound(vardata)
                        Set itm = .ListItems.Add(n - 1, , vardata(n, 1))
                        For lngCol = 2 To UBound(vardata, 2)
                            itm.ListSubItems.Add , , vardata(n, lngCol)
                        Next lngCol
                    Next n
                End With
            
        End With

    End Sub

[]s

[joseA]

Obrigado Mauro,

Agora rodou legal, atualizei o anexo corrigido.

Fica aí uma opção para um preenchimento, sem a chatice de ficar definindo títulos e largura de colunas e sequência de dados para linha e colunas uma a uma. Lógico que em algumas conveniencias o modo "tradicional" prevalecerá.

Abraços.