×
Ir ao conteúdo
  • Cadastre-se

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


Ir à solução Resolvido por Basole,

Posts recomendados

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.

 

 

image.png.88bb5038a850d39c3a6bfee0f03803e2.png

 

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

Link para o comentário
Compartilhar em outros sites

@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

 

 

 

Link para o comentário
Compartilhar em outros sites

@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:

 

image.thumb.png.18928ef6486755eaaeb4806737b766c2.png

 

 

 

Link para o comentário
Compartilhar em outros sites

@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

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

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

 

 image.thumb.png.44e57e87eeedb15c4b4c8a87483cec44.png

 

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

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

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

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

@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 :D 

 

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.

image.thumb.png.3d9ca4e1cb769d96a6bea83edc10b111.png

Projeto.rar

Link para o comentário
Compartilhar em outros sites

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 :D 

 

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.

image.thumb.png.3d9ca4e1cb769d96a6bea83edc10b111.png

Projeto.rar 43 kB · 0 downloads

 

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

Link para o comentário
Compartilhar em outros sites

@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

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

@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 😢 

 

image.png.84dbe9d129b82eefc21f47eac8ab6153.png

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 😢 

 

image.png.84dbe9d129b82eefc21f47eac8ab6153.png

 

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

Link para o comentário
Compartilhar em outros sites

  • Solução

@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

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

  • 4 meses depois...

@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

 

  • Curtir 2
Link para o comentário
Compartilhar em outros sites

@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

  

  • Amei 1
Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Curso de Hacker Ético

LANÇAMENTO!

CLIQUE AQUI E CONFIRA!

* Este curso não é ministrado pela equipe do Clube do Hardware.