Excel Carregar listbox com mais de 10 colunas com base de dados em access

[josequali]

Boa noite. Como carregar mais de 10 colunas no dentro do listbox1 utilizando como base de dados o access? Queira que todas as colunas carregassem dentro da listbox1.

 

Utilizei o seguinte código para pesquisa e preencher as colunas, mas quando chega na coluna 10, o código da erro.

 

 

 

Private Sub BtnBuscar_Click()

Dim vBusca As String
Dim LinhaListbox As Integer

    
    LinhaListbox = 0
    ListBox1.Clear
    ListBox1.ColumnCount = 12
    ListBox1.ColumnWidths = "30;200;100;100;100;100;100;100;100;100;100;100"

    
    vBusca = TextBox5.Text
    

    conectdb 'conectar ao banco de dados e carregar
         rs.Open "Select * from TabCadastro where Nome like'" & Replace(vBusca, "'", "''") & "%'" & _
          "or Codigo like '" & Replace(vBusca, "'", "''") & "%'" & " or Idade like '" & Replace(vBusca, "'", "''") & "%'" & " or Sexo like '" & Replace(vBusca, "'", "''") & "%'", db, 3, 3
                   
              Do Until rs.EOF
                  
                      With ListBox1
                           
                         .AddItem
                           
                             .List(LinhaListbox, 0) = rs(0)
                             .List(LinhaListbox, 1) = rs(1)
                             .List(LinhaListbox, 2) = rs(2)
                             .List(LinhaListbox, 3) = rs(3)
                             .List(LinhaListbox, 4) = rs(4)
                             .List(LinhaListbox, 5) = rs(5)
                             .List(LinhaListbox, 6) = rs(6)
                             .List(LinhaListbox, 7) = rs(7)
                             .List(LinhaListbox, 8) = rs(8)
                             .List(LinhaListbox, 9) = rs(9)
                             .List(LinhaListbox, 10) = rs(10)
                             '.List(LinhaListbox, 11) = rs(11)
                            
                             
                             
                        
                       
                      End With
         
                        LinhaListbox = LinhaListbox + 1
                       rs.MoveNext
             Loop
             
             
    ContagemdeLinhas.Caption = ListBox1.ListCount 'contagem de linhas
    FechaDb 'fehcar o banco de dados
    
    
End Sub

 

Segue em anexo o modelo do projeto. Desde já, agradeço a ajuda de todos.  

 

 

Projeto.rar

[Basole]

@josequali experimente criar uma matriz para carregar os  dados obtidos na pesquisa no access e na propriedade list do listbox carregar a matriz, desta forma o listbox é dimensionado, não gerando o erro de adicionar itens em mais de 10 colunas.

Ex

 

Dim rsArray As Variant. 

.........

 

rsArray = rs.GetRows

.............

 

With Listbox1

    .Clear

    .ColumnCount = 12

    .List = Application.Transpose(rsArray)

     .ColumnWidths = "30;200;100;100;100;100;100;100;100;100;100;100"

    .ListIndex = -1

End With

 

 

 

[josequali]

@Basole não consegui ajustar

[josequali]

@Basole o código ficou assim.

Dim vBusca As String
Dim LinhaListbox As Integer
Dim rsArray As Variant

    
      
    vBusca = TextBox5.Text
    

    conectdb 'conectar ao banco de dados e carregar
     
         rs.Open "Select * from TabCadastro where Nome like'" & Replace(vBusca, "'", "''") & "%'" & _
          "or Codigo like '" & Replace(vBusca, "'", "''") & "%'" & " or Idade like '" & Replace(vBusca, "'", "''") & "%'" & " or Sexo like '" & Replace(vBusca, "'", "''") & "%'", db, 3, 3
             
              Do Until rs.EOF
                 
                  rsArray = rs.GetRows
                 
                      With ListBox1
                          
                         .AddItem
                          
                             .List(LinhaListbox, 0) = rs(0)
                             .List(LinhaListbox, 1) = rs(1)
                             .List(LinhaListbox, 2) = rs(2)
                             .List(LinhaListbox, 3) = rs(3)
                             .List(LinhaListbox, 4) = rs(4)
                             .List(LinhaListbox, 5) = rs(5)
                             .List(LinhaListbox, 6) = rs(6)
                             .List(LinhaListbox, 7) = rs(7)
                             .List(LinhaListbox, 8) = rs(8)
                             .List(LinhaListbox, 9) = rs(9)
                             '.List(LinhaListbox, 10) = rs(10)
                             '.List(LinhaListbox, 11) = rs(11)
                            
                             
                         .Clear
                         .ColumnCount = 12
                         .List = Application.Transpose(rsArray)
                         .ColumnWidths = "30;200;100;100;100;100;100;100;100;100;100;100"
                         .ListIndex = -1
                         
                      End With
         
                       LinhaListbox = LinhaListbox + 1
                       rs.MoveNext
                       Loop
             
 
    FechaDb 'fehcar o banco de dados
    
    
End Sub

 

Mas está dando esse erro:

 

 

 

 

[Basole]

@josequali neste caso voce tem que eliminar parte do seu codigo e considerar minha Sugestão.

 

Fazendo os ajustes, veja como ficou:

 

Private Sub BtnBuscar_Click()
Dim vBusca       As String
Dim LinhaListbox As Integer
Dim rsArray      As Variant

    vBusca = TextBox5.Text
    

    conectdb 'conectar ao banco de dados e carregar
         rs.Open "Select * from TabCadastro where Nome like'" & Replace(vBusca, "'", "''") & "%'" & _
          "or Codigo like '" & Replace(vBusca, "'", "''") & "%'" & " or Idade like '" & Replace(vBusca, "'", "''") & "%'" & " or Sexo like '" & Replace(vBusca, "'", "''") & "%'", db, 3, 3
                  
           
        If Not rs.EOF Then
           
          rsArray = rs.GetRows
           
          With ListBox1

                .Clear
                .ColumnCount = 12
                .ColumnWidths = "30;200;100;100;100;100;100;100;100;100;100;100"
                .List = Application.Transpose(rsArray)
                .ListIndex = -1
            
           End With
                    
         End If
                           
             
      ContagemdeLinhas.Caption = ListBox1.ListCount & " registros encontrados"  'contagem de linhas
      ContagemdeLinhas.Width = 144                                              ' ajusta a largura da label
    
      FechaDb 'fehcar o banco de dados
    
    
End Sub

 

[josequali]

@Basole Funcionou perfeitamente na listbox, mas agora quando faco uma pesquisa a listbox fica toda desformatada  

Projeto.rar

 

 

Todos os dados carregam em uma única coluna  

[Basole]

@josequali pra mim tá normal, testando o seu proprio arquivo:

 

 

 

Experimente alterar esta linha do listbox:

 

.List = rsArray 

 

* A funcao Transpose, as vezes da imcompatibilidade. Entao, tente usar esta função. Cole no modulo 1: 

 

Public Function TransposeArray(myarray As Variant) As Variant
Dim X As Long
Dim Y As Long
Dim Xupper As Long
Dim Yupper As Long
Dim tempArray As Variant
    Xupper = UBound(myarray, 2)
    Yupper = UBound(myarray, 1)
    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = myarray(Y, X)
        Next Y
    Next X
    TransposeArray = tempArray
End Function

 

E no Listbox: 

 .List = TransposeArray(rsArray)

 

@josequali * Atualizei as informações !!!!

[josequali]

@Basole Perfeito! Muito Obrigado  

10 minutos atrás, josequali disse:

@Basole Perfeito! Muito Obrigado  

Me tire uma dúvida. No meu código eu faço a pesquisa utilizando um código que busca em todas as colunas (que é o que eu uso no código lá acima)

conectdb 'conectar ao banco de dados e carregar
         rs.Open "Select * from TabCadastro where Nome like'" & Replace(vBusca, "'", "''") & "%'" & _
          "or Codigo like '" & Replace(vBusca, "'", "''") & "%'" & " or Idade like '" & Replace(vBusca, "'", "''") & "%'" & " or Sexo like '" & Replace(vBusca, "'", "''") & "%'", db, 3, 3
                  

 

Entretanto, como eu poderia fazer para procurar separadamente, por exemplo. Eu quero procurar no meu banco de dados filtrando por Idade e Sexo, ou sexo e endereço, usando para cada um um textbox diferente. Porquê normalmente vejo quando é em access o pessoal usando só um filtro, e preciso separa-los porque uso como pesquisa de Indicador dos meus dados para relatório.  . Vou criar um novo tópico e mencionar.

[josequali]

@Basole Me tire uma dúvida. Fiz alguma verificações agora e percebi que quando a minha segunda linha não tem informações preenchida, as textbox ficam gravadas com as informações da primeira linha  do meu baco de dados. Como poderia resolver isso. Tentei de tudo mas não consegui  . Desde já agradeço a ajuda e disponibilidade  

 

Segue abaixo a foto do que está acontecendo. Se você observar, caso eu selecione a primeira linha e em seguida a segunda, está conserva os dados da primeira nas textbox. Segue em anexo a planilha e o banco de dados em Access.

Projeto.rar

[josequali]

8 horas atrás, josequali disse:

@Basole Me tire uma dúvida. Fiz alguma verificações agora e percebi que quando a minha segunda linha não tem informações preenchida, as textbox ficam gravadas com as informações da primeira linha  do meu baco de dados. Como poderia resolver isso. Tentei de tudo mas não consegui  . Desde já agradeço a ajuda e disponibilidade  

 

Segue abaixo a foto do que está acontecendo. Se você observar, caso eu selecione a primeira linha e em seguida a segunda, está conserva os dados da primeira nas textbox. Segue em anexo a planilha e o banco de dados em Access.

Projeto.rar 43 kB · 0 downloads

 

Caso também alguém possa ajudar agradeço

[Basole]

@josequali

Citação

Me tire uma dúvida. Fiz alguma verificações agora e percebi que quando a minha segunda linha não tem informações preenchida, as textbox ficam gravadas com as informações da primeira linha  do meu baco de dados. Como poderia resolver isso. Tentei de tudo mas não consegui  . Desde já agradeço a ajuda e disponibilidade  

Esta acontecendo isso, porque no seu codigo ao selecionar 1 item do listbox, esta fazendo uma nova consulta ao BD.

Nesta caso nao e necessario, pois os dados ja estão dispostos no listbox.

Segue as alteracoes: 

 

Private Sub ListBox1_Click()

     
     With ME.ListBox1
      
            If .ListIndex > -1 Then
               Me.txtnome.Text = .List(.ListIndex, 1)
               Me.txtsexo.Text = .List(.ListIndex, 2)
               Me.txtidade.Text = .List(.ListIndex, 3)
               Me.txtcpf.Text = .List(.ListIndex, 4)
               Me.txtrg.Text = .List(.ListIndex, 5)
               Me.txtendereco.Text = .List(.ListIndex, 6)
               Me.txtbairro.Text = .List(.ListIndex, 7)
               Me.txtdata.Text = .List(.ListIndex, 8)
               Me.txtcep.Text = .List(.ListIndex, 9)
               Me.txttelefone.Text = .List(.ListIndex, 10)
             End If
             
     End With
  
End Sub

 

[josequali]

@Basole eu tinha tentado assim, mas como meu banco de DADOS no access tem campos que estão vazios ela aparece esse erro porque ele vê que tem campos vazios  . Já tinha tentado esse método, mas não consegui  

 

agora, josequali disse:

@Basole eu tinha tentado assim, mas como meu banco de DADOS no access tem campos que estão vazios ela aparece esse erro porque ele vê que tem campos vazios  . Já tinha tentado esse método, mas não consegui  

 

 

Estou colocando nesse exemplo campos vazio, porque na planilha maior existem campos que devem ser preenchidos gradativamente a medida que o banco de dados vai sendo alimentado por fases do projeto.  

[Basole]

@josequali 

No ListBox, seus campos aceita valores em branco. 

O problema é que no BD Access, o campo em branco o valor é Null, por isso o erro. 

Para dribrar este problema, fiz uns ajustes na função TransposeArray: 

 

Public Function TransposeArray(myarray As Variant) As Variant
Dim X As Long
Dim Y As Long
Dim Xupper As Long
Dim Yupper As Long
Dim tempArray As Variant
    Xupper = UBound(myarray, 2)
    Yupper = UBound(myarray, 1)
    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
        If VBA.IsNull(myarray(Y, X)) Then
            tempArray(X, Y) = ""
        Else
            tempArray(X, Y) = myarray(Y, X)
        End If
        Next Y
    Next X
    TransposeArray = tempArray
End Function

 

[josequali]

@Basole Perfeito  Muito obrigado!!!!!! Deus te abençoe @Basole

[Helton5antos]

boa tarde @josequali é possível você me encaminhar esse seu arquivo excel,
estou bem no início desse projeto e de cara já estou tendo o mesmo problema para inserir informações na listbox com mais de 10 colunas conforme meu arquivo em anexo.

fico grato pela ajuda.

obrigado.

 

EstruturaNominal.zip

[Basole]

@H3l70N pelo que entendi voce quer popular os dados de uma tabela do BD access no listbox.

 

Experimente o codigo abaixo:

 

Sub EstruturaNominal_Preencher_Listbox()
'   PESQUISAR DADOS NO BD:
    Dim rsArray As Variant
    
    ConectaBD  'Abrir o BD
    SQL = "SELECT * FROM tblEstruturaNominal"   'Declarar as instruçoes SQL
    
    Call AbrirTabela  'Validar comando SQL para Abrir Tabela no BD

    frmEstruturaNominal.lstEstruturaNominal.Clear
    
    If Not RS.EOF Then
    
         rsArray = RS.GetRows
    
         frmEstruturaNominal.lstEstruturaNominal.List = TransposeArray(rsArray)
    
    End If
  
    DesconectaBD
End Sub

Private Function TransposeArray(myarray As Variant) As Variant
Dim X As Long
Dim Y As Long
Dim Xupper As Long
Dim Yupper As Long
Dim tempArray As Variant
    Xupper = UBound(myarray, 2)
    Yupper = UBound(myarray, 1)
    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = myarray(Y, X)
        Next Y
    Next X
    TransposeArray = tempArray
End Function

 

[Helton5antos]

@Basole

funcionou perfeitamente para mostrar uma sequencia de colunas.

 

é possível eu definir nesse código quais colunas que eu quero apresentar como por exemplo:

para trazer apenas as colunas: 0; 1; 2; 5; 7; 9; 11; 13; 14; 16; 17

 

[Basole]

@Helton5antos sim, há outras possibilidades, inserindo criterios definindo os campos que podem carregar os dados no listbox, mas eu prefiro desta forma, definindo na cláusula SQL, quais campos serão selecionados na pesquisa.

No caso, com somente o asterisco  ( * ), todos campos serão incluidos na pesquisa, mas neste caso vamos definir somente os campos que voce citou.

Veja como fica, com as alterações:

 

Sub EstruturaNominal_Preencher_Listbox()
'   PESQUISAR DADOS NO BD:
    Dim rsArray As Variant
    Dim CampsTbl As String
    
     CampsTbl = "Identificação,CodigoCADM,CodigoRG,OrdemIG," & _
                "TipoIG,OrdemJCE,CodigoJCE,TipoJCE,OrdemJC,CodigoJC"
     
    ConectaBD  'Abrir o BD
    
    'Declarar as instruçoes SQL:
    
    SQL = "SELECT " & CampsTbl & " FROM tblEstruturaNominal"
    
    
    
    Call AbrirTabela  'Validar comando SQL para Abrir Tabela no BD

    frmEstruturaNominal.lstEstruturaNominal.Clear
    
    If Not RS.EOF Then
    
         rsArray = RS.GetRows
    
         frmEstruturaNominal.lstEstruturaNominal.List = TransposeArray(rsArray)
    
    End If
  
    DesconectaBD
End Sub

 

* Substitua o código acima, no seu projeto, mantendo a função TransposeArray

  

[Helton5antos]

@Basole desculpa pela demora no retorno.

informo que as soluções informadas, funcionou perfeitamente.

muito obrigado pela grande ajuda na resolução desses meus casos.