Adicionando item de um combo a uma lista

Amigos, estou com um probleminha no nosso querido Access. Uso muito o access mas sempre em modo estrutura, portanto agora que estou utilizando o VB, e por sinal estou quebrando a cabeça. rsrs
Preciso popular uma lista que inserido de uma pesquisa no formulário através de uma combo, está funcionando, porém só insere o primeiro item da lista do combo, qualquer um que seleciono para inserção na lista que funciona como um subformulário, continua inserindo somente o primeiro registro. Como fazer para que seja inserido o registro foi selecionado da combo na lista?

Segue a baixo o código:


Private Sub txtPesquisar_AfterUpdate

On Error GoTo TErro

Dim Descricao As String, Cnpj As String, Cod As Double

If IsNull(Me.txtPesquisar) Or Me.txtPesquisar.Value = "" Or Len(Me.txtPesquisar) < 2 Then
MsgBox "Não foi digitado um fornecedor válido.", , "ATENÇÃO"
Me.txtPesquisar.SetFocus
Me.txtPesquisar = Null
Else

If IsNull(DLookup("nome_empresa", "cad_fornecedor", "nome_empresa" & Descricao)) Then
MsgBox "O nome_empresa """ & Descricao & """é inexistente." & vbCrLf & "Por favor, verifique e tente novamente.", vbOKOnly + vbCritical, "ATENÇÃO"
Me.txtPesquisar.SetFocus
Me.txtPesquisar = Null
Else
Me.lstFornecedor.RowSourceType = "value list"
Me.lstFornecedor.AddItem Item:=DLookup("Código", "cad_fornecedor", "nome_empresa" & Descricao) & ";" & _
Format(DLookup("nome_empresa", "cad_fornecedor", "nome_empresa" & Descricao), "currency") & ";" & _
Format(DLookup("cnpj", "cad_fornecedor", "nome_empresa" & Descricao), "currency") & ";" & _
Format(DLookup("telefone", "cad_fornecedor", "nome_empresa" & Descricao), "currency")
Me.txtPesquisar = Null
End If

End If

TErro:

If Error = 2471 Then
MsgBox "Nesse campo não deve ser digitado texto, apenas ""nome da empresa", vbOKOnly + vbCritical, "ERRO"
ElseIf Err.Number = 3075 Then
MsgBox "Nesse campo deve ser digitado apenas nome_empresa do fornecedor.", vbOKOnly + vbCritical, "ERRO"
Else
Resume Next
End If

End Sub

Olá, seja bem vindo ao forum! Para pegar mais de uma linha, você precisará criar um Recordset e fazer um Loop:

Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM NomeDaTabela WHERE SeuFiltro")

Me.NomeDaList.RowSourceType = "Value List"
Me.NomeDaList.RowSource = ""

Do While Not rs.EOF
Me.NomeDaList.AddItem rs!Campo1 & ";" & rs!Campo2
rs.MoveNext
Loop

rs.Close
Set rs = Nothing

Amigo não funcionou. Segue a imagem do form.


a combo recebe dados de uma consulta, e selecionando um registro dessa consulta na combo-box que desejo inserir na lista de fornecedores(lstFornecedor) quantos forem necessário.[img]Amigo não funcionou. Segue a imagem do form. a combo recebe dados de uma consulta, e selecionando um registro dessa consulta na combo-box que desejo inserir na lista de fornecedores(lstFornecedor) quantos forem necessário.

Você está usando DLookup, que pesquisa os dados na tabela. O certo então seria colocar o nome da combo no lugar do DLookup:

Me.NomeDaList.RowSourceType = "Value List"
Me.NomeDaList.AddItem Me.NomeDaCombo.Column(0) & ";" & Me.NomeDaCombo.Column(1)

Não use Me.NomeDaList.RowSource = "", pois isso limpa a listbox, deixando ela apenas com a linha inserida por último.

Amigo,
estou enviando o mdb pra você dar uma olhada no formulário pesquisa_fornecedores. Veja o código do botão "Adicionar", e sinta se a vontade pra fazer o treco funcionar meu amigo.

Veja no anexo abaixo. Observe a "Origem da linha" da combo txtPesaquisar, a "Largura das colunas dessa combo e o evento "Ao clicar" do botão btnAdicionar.

Boa tarde meu caro,
Muito obrigado por mais uma ajuda, agora deu tudo certinho, só tem um porém. Como validar uma combo pra não inserir um valor valor? E também não inserir dados duplicados?

Código

Private Sub btnAdicionar_Click()

On Error GoTo TErro

Me.lstFornecedor.RowSourceType = "Value List"

Me.lstFornecedor.AddItem Me.txtPesquisar.Column(0) & ";" & Me.txtPesquisar.Column(1) & ";" & Me.txtPesquisar.Column(2) & ";" & Me.txtPesquisar.Column(3)

Me.txtPesquisar = Null

TErro:

If Error = 2471 Then
MsgBox "Nesse campo não deve ser digitado texto, apenas ""nome do Fornecedor"".", vbOKOnly + vbCritical, "ERRO"
ElseIf Err.Number = 3075 Then
MsgBox "Nesse campo deve ser digitado apenas nome do fornecedor.", vbOKOnly + vbCritical, "ERRO"
Else
Resume Next
End If

End Sub

Para isso, melhor limpar a origem da combo e preenchê-la com uma lista de valores, pegando os dados da tabela em um Loop dentro de um Recordset, pois, dessa maneira, você poderá excluir o item já adicionado da combo. No início do módulo vba do form, logo abaixo da linha "Option Explicit", adicione uma variável de nome LIndex para usar no evento "Após atualizar" da combo para capturar o índice da linha e adicione tambem uma função para preencher a combo de fornecedores, como abaixo:

Código:

Dim LIndex As Integer

Private Function ListaFornecedores()

    Dim rs As Recordset
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM cad_fornecedor ORDER BY nome_empresa")
   
    Me.txtPesquisar.RowSourceType = "Value List"
    Me.txtPesquisar.RowSource = ""
   
    Do While Not rs.EOF
        Me.txtPesquisar.AddItem rs!Código & ";" & rs!nome_empresa & ";" & rs!Cnpj & ";" & rs!telefone
        rs.MoveNext
    Loop
   
    rs.Close
    Set rs = Nothing

End Function

No evento "Ao carregar" do formulário, chame a função criada para preencher a combo:

Código:

Call ListaFornecedores

No botão, mude para:

Código:

If IsNull(Me.txtPesquisar) Or Me.txtPesquisar.Value = "" Then
    MsgBox "Você não escolheu um produto para lançar. Escolha um.", vbCritical, "Erro de operação"
    Me.txtPesquisar.SetFocus
Else
    Me.lstFornecedor.RowSourceType = "Value List"
    Me.lstFornecedor.AddItem Me.txtPesquisar.Column(0) & ";" & Me.txtPesquisar.Column(1) & ";" & Me.txtPesquisar.Column(2) & ";" & Me.txtPesquisar.Column(3)
    Me.txtPesquisar.RemoveItem LIndex
    Me.txtPesquisar.Requery
End If

No evento "Após atualizar" da combo:

Código:

    LIndex = Me.txtPesquisar.ListIndex

Lembrando que você deve limpar a origem da combo, pois ela não terá mais a origem como "Tabela" e sim "Lista de valores", por isso, altere tambem a linha "Tipo de Origem da Linha" para "Lista de valores". Lembre tambem de chamar a função novamente após concluir a venda para poder preencher novamente a lista de fornecedores na combo.

Olá meu caro,

Muito obrigado nesta grande e valiosa ajuda!

Deus o abençoe.

Até breve!