MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Ajuda com código VBA para múltipla seleção em consulta

    Compartilhe

    socgyn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 105
    Registrado : 01/05/2013

    [Resolvido]Ajuda com código VBA para múltipla seleção em consulta

    Mensagem  socgyn em Sab 26 Abr 2014, 23:20

    [Você precisa estar registrado e conectado para ver esta imagem.]

    A imagem acima de uma consulta de estoque, a qual mostra produto, entrada, saída e estoque, Na caixa de listagem tem todos os itens já cadastrados, assim como no subformulário.
    Quando clico no item na caixa de listagem ele filtra no subformulário abaixo, só que só um item por vez. Tenho duas opções de seleção acima para abrir os relatórios. Geral ou por produto. Geral, é claro, abre o relatório com todos os itens, por produto só o selecionado e filtrado no subformulário. Que neste caso só um por vez.
    O que eu queria é que a medida que eu fosse clicando nos itens na caixa de listagem ele fosse adicionado no subformulário, ou seja, múltipla seleção. Posteriormente quando selecionasse a opção para abrir relatório "por produto" ele pegasse essas informações.
    Já vi vários exemplos aqui e não consegui adequar, tem um nos moldes do que tô tentando, mas ele adiciona os itens em caixas de textos separadas com limite de caixas de texto.
    O que seria perfeito era no subformulário, porque se eu selecionasse 30, 50 itens aleatoriamente, teria essa informação em relatório.

    socgyn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 105
    Registrado : 01/05/2013

    Ajuda com código VBA para múltipla seleção em consulta

    Mensagem  socgyn em Seg 28 Abr 2014, 01:16

    Peguei um exemplo aqui de multipla seleção e tentei adequar, funcionou de certa forma, mas não busca todas as informações que preciso. Ex.:

    Tem uma listbox com 02 Colunas 0cm;2,54cm;
    os dados de origem: SELECT csProd.CodP, csProd.DescP FROM csProd ORDER BY [Descp];


    Uma caixa de texto, a qual receberá os dados selecionados

    E um botão com o cód ao clicar:


    Private Sub btAdd_Click()

    Call BoundData

    End Sub

    Sub BoundData()

    Dim frm As Form, ctl As Control
    Dim varItm As Variant

    Set frm = Forms!frmListBox
    Set ctl = frm!CaixaDeListagem

    Me.CaixaDeTexto = Null

    For Each varItm In ctl.ItemsSelected 'eis o salvador da Pátria. Mais informações coloque o cursor no meio da palavra ItemsSelected e aperte F1.

    If IsNull(Me.CaixaDeTexto) Or Me.CaixaDeTexto.Value = "" Then
    Me.CaixaDeTexto = ctl.ItemData(varItm)

    Else

    Me.CaixaDeTexto = Me.CaixaDeTexto & vbNewLine & ctl.ItemData(varItm)
    End If

    Next varItm

    End Sub


    Até aí tudo bem, só que na caixa de texto só aparece o nome do item, preciso que, ao selecionar os itens na listbox, apareça na caixa de texto o Cód do item, o nome, entrada, saída e estoque.

    Já tentei de várias formas e não consigo resolver. Lembrando que as primeiras tentativas era para ir para um subformulário, como não consegui vi este exemplo (listbox e caixa de texto) e tentei adequar. Se alguém puder dar uma força.

    socgyn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 105
    Registrado : 01/05/2013

    Ajuda com código VBA para múltipla seleção em consulta

    Mensagem  socgyn em Qua 30 Abr 2014, 01:26

    Boa noite à todos,

    Desisti de fazer conforme havia pedido ajuda. Achei uma outra solução, vejamos:
    a imagem abaixo representa uma caixa de listagem com select que busca informações dos itens, nas
    caixas de texto, cada vez que clico em um item ele vai para uma delas. (arquivo adaptado de um exemplo aqui do fórum)
    O problema agora é que não consigo abrir o relatório para impressão com esses itens, ou seja buscando a informação completa deles
    jogando-os no relatório. O relatório abre em branco ou em algumas tentativas imprime a tela do formulário e não o relatório com os dados.
    [Você precisa estar registrado e conectado para ver esta imagem.]

    No botão imprimir  o código ao clicar está:

    Private Sub Comando12_Click()
    On Error Resume Next
    DoCmd.OpenReport "REstoGer", acViewPreview, "", "[DescP] = forms![teste]![SuaCombo] "", acNormal"
    If MsgBox("Impressão da Ficha?", vbOKCancel + vbQuestion, "Confirmação de Impressão") = vbOK Then
    DoCmd.RunCommand acCmdPrint

    End If

    End Sub

    SuaCombo é a caixa de listagem, quando seleciono alguma coisa ele imprime a tela do formulário e nem abre o relatório.
    já mudei diversas vezes esse código e sem sucesso, não consigo capturar os registros selecionados.

    outra coisa de que preciso é um código para limpar as caixas de texto, após itens selecionados só ficam limpas após fechar e abrir novamente o formulário

    na caixa de listagem adaptei o código assim:

    Private Sub SuaCombo_AfterUpdate()

    If IsNull(Me.txt1) Then
       If Me.SuaCombo = Me.txt2 Or Me.SuaCombo = Me.txt3 Or Me.SuaCombo = Me.txt4 Or Me.SuaCombo = Me.txt5 _
       Or Me.SuaCombo = Me.txt6 Or Me.SuaCombo = Me.txt7 Or Me.SuaCombo = Me.txt8 Or Me.SuaCombo = Me.txt9 _
       Or Me.SuaCombo = Me.txt10 Or Me.SuaCombo = Me.txt11 Or Me.SuaCombo = Me.txt12 Or Me.SuaCombo = Me.txt13 _
       Or Me.SuaCombo = Me.txt14 Or Me.SuaCombo = Me.txt15 Or Me.SuaCombo = Me.txt16 Or Me.SuaCombo = Me.txt17 _
       Or Me.SuaCombo = Me.txt18 Or Me.SuaCombo = Me.txt19 Or Me.SuaCombo = Me.txt20 Or Me.SuaCombo = Me.txt21 _
       Or Me.SuaCombo = Me.txt22 Or Me.SuaCombo = Me.txt23 Or Me.SuaCombo = Me.txt24 Or Me.SuaCombo = Me.txt25 _
       Or Me.SuaCombo = Me.txt26 Then
       MsgBox "Esse Código já foi escolhido."
       Cancel = True
       Else
       Me.txt1 = Me.SuaCombo
       End If
    ElseIf IsNull(Me.txt2) Then
       If Me.SuaCombo = Me.txt1 Or Me.SuaCombo = Me.txt3 Or Me.SuaCombo = Me.txt4 Or Me.SuaCombo = Me.txt5 _
       Or Me.SuaCombo = Me.txt6 Or Me.SuaCombo = Me.txt7 Or Me.SuaCombo = Me.txt8 Or Me.SuaCombo = Me.txt9 _
       Or Me.SuaCombo = Me.txt10 Or Me.SuaCombo = Me.txt11 Or Me.SuaCombo = Me.txt12 Or Me.SuaCombo = Me.txt13 _
       Or Me.SuaCombo = Me.txt14 Or Me.SuaCombo = Me.txt15 Or Me.SuaCombo = Me.txt16 Or Me.SuaCombo = Me.txt17 _
       Or Me.SuaCombo = Me.txt18 Or Me.SuaCombo = Me.txt19 Or Me.SuaCombo = Me.txt20 Or Me.SuaCombo = Me.txt21 _
       Or Me.SuaCombo = Me.txt22 Or Me.SuaCombo = Me.txt23 Or Me.SuaCombo = Me.txt24 Or Me.SuaCombo = Me.txt25 _
       Or Me.SuaCombo = Me.txt26 Then
       MsgBox "Esse Código já foi escolhido."
       Cancel = True
       Else
       Me.txt2 = Me.SuaCombo
       End If
    ElseIf IsNull(Me.txt3) Then
       If Me.SuaCombo = Me.txt1 Or Me.SuaCombo = Me.txt2 Or Me.SuaCombo = Me.txt4 Or Me.SuaCombo = Me.txt5 _
       Or Me.SuaCombo = Me.txt6 Or Me.SuaCombo = Me.txt7 Or Me.SuaCombo = Me.txt8 Or Me.SuaCombo = Me.txt9 _
       Or Me.SuaCombo = Me.txt10 Or Me.SuaCombo = Me.txt11 Or Me.SuaCombo = Me.txt12 Or Me.SuaCombo = Me.txt13 _
       Or Me.SuaCombo = Me.txt14 Or Me.SuaCombo = Me.txt15 Or Me.SuaCombo = Me.txt16 Or Me.SuaCombo = Me.txt17 _
       Or Me.SuaCombo = Me.txt18 Or Me.SuaCombo = Me.txt19 Or Me.SuaCombo = Me.txt20 Or Me.SuaCombo = Me.txt21 _
       Or Me.SuaCombo = Me.txt22 Or Me.SuaCombo = Me.txt23 Or Me.SuaCombo = Me.txt24 Or Me.SuaCombo = Me.txt25 _
       Or Me.SuaCombo = Me.txt26 Then
       MsgBox "Esse Código já foi escolhido."
       Cancel = True
       Else
       Me.txt3 = Me.SuaCombo
       End If
    ElseIf IsNull(Me.txt4) Then
       If Me.SuaCombo = Me.txt1 Or Me.SuaCombo = Me.txt2 Or Me.SuaCombo = Me.txt3 Or Me.SuaCombo = Me.txt5 _
       Or Me.SuaCombo = Me.txt6 Or Me.SuaCombo = Me.txt7 Or Me.SuaCombo = Me.txt8 Or Me.SuaCombo = Me.txt9 _
       Or Me.SuaCombo = Me.txt10 Or Me.SuaCombo = Me.txt11 Or Me.SuaCombo = Me.txt12 Or Me.SuaCombo = Me.txt13 _
       Or Me.SuaCombo = Me.txt14 Or Me.SuaCombo = Me.txt15 Or Me.SuaCombo = Me.txt16 Or Me.SuaCombo = Me.txt17 _
       Or Me.SuaCombo = Me.txt18 Or Me.SuaCombo = Me.txt19 Or Me.SuaCombo = Me.txt20 Or Me.SuaCombo = Me.txt21 _
       Or Me.SuaCombo = Me.txt22 Or Me.SuaCombo = Me.txt23 Or Me.SuaCombo = Me.txt24 Or Me.SuaCombo = Me.txt25 _
       Or Me.SuaCombo = Me.txt26 Then
       MsgBox "Esse Código já foi escolhido."
       Cancel = True
       Else
       Me.txt4 = Me.SuaCombo
       End If
    ElseIf IsNull(Me.txt5) Then
       If Me.SuaCombo = Me.txt1 Or Me.SuaCombo = Me.txt2 Or Me.SuaCombo = Me.txt3 Or Me.SuaCombo = Me.txt4 _
       Or Me.SuaCombo = Me.txt6 Or Me.SuaCombo = Me.txt7 Or Me.SuaCombo = Me.txt8 Or Me.SuaCombo = Me.txt9 _
       Or Me.SuaCombo = Me.txt10 Or Me.SuaCombo = Me.txt11 Or Me.SuaCombo = Me.txt12 Or Me.SuaCombo = Me.txt13 _
       Or Me.SuaCombo = Me.txt14 Or Me.SuaCombo = Me.txt15 Or Me.SuaCombo = Me.txt16 Or Me.SuaCombo = Me.txt17 _
       Or Me.SuaCombo = Me.txt18 Or Me.SuaCombo = Me.txt19 Or Me.SuaCombo = Me.txt20 Or Me.SuaCombo = Me.txt21 _
       Or Me.SuaCombo = Me.txt22 Or Me.SuaCombo = Me.txt23 Or Me.SuaCombo = Me.txt24 Or Me.SuaCombo = Me.txt25 _
       Or Me.SuaCombo = Me.txt26 Then
       MsgBox "Esse Código já foi escolhido."
       Cancel = True
       Else
       Me.txt5 = Me.SuaCombo
       End If
    ElseIf IsNull(Me.txt6) Then
       If Me.SuaCombo = Me.txt1 Or Me.SuaCombo = Me.txt2 Or Me.SuaCombo = Me.txt3 Or Me.SuaCombo = Me.txt4 _
       Or Me.SuaCombo = Me.txt7 Or Me.SuaCombo = Me.txt8 Or Me.SuaCombo = Me.txt9 _
       Or Me.SuaCombo = Me.txt10 Or Me.SuaCombo = Me.txt11 Or Me.SuaCombo = Me.txt12 Or Me.SuaCombo = Me.txt13 _
       Or Me.SuaCombo = Me.txt14 Or Me.SuaCombo = Me.txt15 Or Me.SuaCombo = Me.txt16 Or Me.SuaCombo = Me.txt17 _
       Or Me.SuaCombo = Me.txt18 Or Me.SuaCombo = Me.txt19 Or Me.SuaCombo = Me.txt20 Or Me.SuaCombo = Me.txt21 _
       Or Me.SuaCombo = Me.txt22 Or Me.SuaCombo = Me.txt23 Or Me.SuaCombo = Me.txt24 Or Me.SuaCombo = Me.txt25 _
       Or Me.SuaCombo = Me.txt26 Then
       MsgBox "Esse Código já foi escolhido."
       Cancel = True
       Else
       Me.txt6 = Me.SuaCombo
       End If
       
       ElseIf IsNull(Me.txt7) Then
       If Me.SuaCombo = Me.txt1 Or Me.SuaCombo = Me.txt2 Or Me.SuaCombo = Me.txt3 Or Me.SuaCombo = Me.txt4 _
       Or Me.SuaCombo = Me.txt6 Or Me.SuaCombo = Me.txt8 Or Me.SuaCombo = Me.txt9 _
       Or Me.SuaCombo = Me.txt10 Or Me.SuaCombo = Me.txt11 Or Me.SuaCombo = Me.txt12 Or Me.SuaCombo = Me.txt13 _
       Or Me.SuaCombo = Me.txt14 Or Me.SuaCombo = Me.txt15 Or Me.SuaCombo = Me.txt16 Or Me.SuaCombo = Me.txt17 _
       Or Me.SuaCombo = Me.txt18 Or Me.SuaCombo = Me.txt19 Or Me.SuaCombo = Me.txt20 Or Me.SuaCombo = Me.txt21 _
       Or Me.SuaCombo = Me.txt22 Or Me.SuaCombo = Me.txt23 Or Me.SuaCombo = Me.txt24 Or Me.SuaCombo = Me.txt25 _
       Or Me.SuaCombo = Me.txt26 Then
       MsgBox "Esse Código já foi escolhido."
       Cancel = True
    Else
       Me.txt7 = Me.SuaCombo
       End If
    End If

    Else
    MsgBox "Já foi escolhido o número máximo de registros", vbOKOnly + vbInformation, "ATENÇÃO"
    End If

    End Sub

    socgyn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 105
    Registrado : 01/05/2013

    Ajuda com código VBA para múltipla seleção em consulta

    Mensagem  socgyn em Qua 30 Abr 2014, 02:27

    Boa Noite,

    O código para botão limpar as caixas de texto já fiz e deu certo, agora falta conseguir enviar os registros selecionados nelas para o relatório, esse está mais
    difícil já tentei vários códigos e o máximo que conseguir é abrir somente com um item selecionado

    Private Sub Comando62_Click()
    Me.txt1 = Null
    Me.txt2 = Null
    Me.txt3 = Null
    Me.txt4 = Null
    Me.txt5 = Null
    Me.txt6 = Null
    Me.txt7 = Null
    Me.txt8 = Null
    Me.txt9 = Null
    Me.txt10 = Null
    Me.txt11 = Null
    Me.txt12 = Null
    Me.txt13 = Null
    Me.txt14 = Null
    Me.txt15 = Null
    Me.txt16 = Null
    Me.txt17 = Null
    Me.txt18 = Null
    Me.txt19 = Null
    Me.txt20 = Null
    Me.txt21 = Null
    Me.txt22 = Null
    Me.txt23 = Null
    Me.txt24 = Null
    Me.txt25 = Null
    Me.txt26 = Null

    End Sub

    socgyn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 105
    Registrado : 01/05/2013

    Ajuda com código VBA para múltipla seleção em consulta

    Mensagem  socgyn em Qua 30 Abr 2014, 04:05

    Boa noite, consegui resolver o problema vou postar a maneira para que se alguém estiver com o mesmo problema possa ajuda-lo.
    A solução depois de muito trabalho se mostrou até simples.

    [Você precisa estar registrado e conectado para ver esta imagem.]

    Fiz um formulário com uma caixa de listagem, atribuí a origem dos dados :

    SELECT csProd.DescP, csProd.CodP FROM csProd ORDER BY csProd.DescP;
    Coluna 2 7cm;0cm , Acoplada 1
    Seleções multiplas : simples

    No botão imprimir:

    Private Sub Comando12_Click()
    On Error Resume Next
    Dim filtro As String
    Dim Sel As Variant
    Dim j As Boolean

    filtro = "in("
    For Each Sel In Me!SuaCombo.ItemsSelected
    filtro = filtro & Me!SuaCombo.Column(1, Sel) & ","
    j = True
    Next
    filtro = Mid(filtro, 1, (Len(filtro) - 1)) & ")"
    filtro = "CodP " & filtro

    If j = False Then
    MsgBox "Selecione uma ou mais registros...", vbInformation, "Aviso"
    Me!SuaCombo.SetFocus
    Me!SuaCombo = 0
    Else
    DoCmd.OpenReport "REstoGer", acViewPreview, , filtro
    End If
    End Sub

    Pronto, abre o formulário com os itens que seleciona na caixa de listagem, para retirar a seleção é só clicar novamente no item,
    caso não tenha nenhum item selecionado, sai a mensagem pedindo para selecionar 1 ou mais registros

      Data/hora atual: Ter 06 Dez 2016, 05:47