Esqueceu sua senha? Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

ListBox com multiseleção, gravando em um array

Ponto de encontro entre aqueles que precisam e fornecem soluções baseadas no Microsoft Excel e VBA. Precisa de uma solucão em VBA? É um consultor ou programador independente? Esse é o lugar!
EmersonABC
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Seg Abr 02, 2018 5:45 pm

ListBox com multiseleção, gravando em um array

Mensagem por EmersonABC » Seg Abr 02, 2018 5:54 pm

Boa tarde a todos,
Estou com o seguinte problema, tenho um form com os seguintes campos, Nome e Idade, assim que o usuário digita os campos, e clica em inserir, os dados aparecem em uma listbox, do mesmo form. Este listbox já esta com multiseleção, e consegui gravar o nome em um array, e consegui passar para a planilha o nome selecionado no listbox. Meu problema é o seguinte, preciso gravar no array, o nome e a idade, e depois preciso passar para apenas uma célula os registros selecionados. Exemplo: se o usuário cadastrou 3 registros, e clicou em dois, e depois clicou em gravar, vou gravar os dois nomes e as duas idades em uma célula da planilha. Abaixo está o código, se alguém tiver a solução eu agradeço....

Private Sub CommandButton1_Click()
Dim vFileList() As Variant
Dim lUpper As Long
Dim lLoop As Long
With Me.ListBox1
For lLoop = 0 To .ListCount - 1
If .Selected(lLoop) Then
lUpper = lUpper + 1: ReDim Preserve vFileList(1 To lUpper)
vFileList(lUpper) = .List(lLoop, 0)
End If
Next lLoop
On Error GoTo ExitSub:
For lLoop = LBound(vFileList) To UBound(vFileList)
linha = Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Teste").Cells(linha, 1) = vFileList(lLoop) & vbCrLf
Next lLoop
End With
Exit Sub
ExitSub:
MsgBox "Nada Selecionado!"
End Sub



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


srobles
Sabe muito
Sabe muito
Mensagens: 663
Registrado em: Qua Mai 06, 2015 7:39 pm

Re: ListBox com multiseleção, gravando em um array

Mensagem por srobles » Qui Abr 26, 2018 12:28 am

EmersonABC,

Experimente o que segue abaixo :

Código: Selecionar todos

Private Sub CommandButton1_Click()
    'Variavel para criarmos uma lista de dados
    Dim listaSelecao()
    'Redimensionamos a lista de acordo com a qtde de itens
    'no ListBOx
    ReDim listaSelecao(ListBox1.ListCount)
    
    'Variaveis para manipularmos os itens do ListBox
    Dim vItem As Long
    Dim a, contador As Long
    contador = 0
        'Para cada item do ListBox
        For vItem = 0 To ListBox1.ListCount - 1
            'Se o mesmo estiver selecionado
            If ListBox1.Selected(vItem) = True Then
                'Incrementamos o contador
                contador = contador + 1
                'Adicionamos o item selecionado á lista de dados
                listaSelecao(contador) = ListBox1.List(vItem, 0) & ", " & ListBox1.List(vItem, 1)
                'Redimensionamos a lista preservando os dados em suas posições
                ReDim Preserve listaSelecao(contador + 1)
            End If
        Next
        
        'Se não houverem itens selecionados no ListBox
        'o que irá retornar o valor do contador igual = 0
        If contador = 0 Then
            'Exibimos a mensagem de erro
            MsgBox "Não foram informados valores / seleção de itens!", vbExclamation, "Erro"
            'Saímos da rotina
            Exit Sub
        End If
        
        'Variavel do tipo String (Texto)
        'Para armazenarmos os dados da lista
        Dim listaValores As String
        'Limpamos a variável
        listaValores = ""
        'Para cada item contido na lista de dados
        For a = 0 To UBound(listaSelecao)
            'Se o item de índice (a) for diferente de nulo
            If listaSelecao(a) <> "" Then
                'Modificamos a variável,
                'adicionando á ela o respectivo item da lista de dados + tecla ENTER
                listaValores = listaValores & listaSelecao(a) & vbCrLf
            End If
        Next
    
    'Variável para retornarmos a ultima linha preenchida da planilha + 1
    Dim ultimaLinha As Long
    ultimaLinha = ThisWorkbook.Sheets("Plan1").Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    'Adicionamos os dados retornados na variável String,
    'modificando a mesma para retirar o último caracter (ENTER)
    Cells(ultimaLinha, 1) = Mid(listaValores, 1, Len(listaValores) - 1)
    'Ajustamos as linhas e colunas da planilha
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    
    'Desmarcamos todos os itens do ListbOx
    For vItem = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(vItem) = False
    Next
    
    'Limpamos os campos
    TextBox1 = ""
    TextBox2 = ""
    'Selecionamos o TextBox1
    TextBox1.SetFocus
    
    'Notificamos do término da operação
    MsgBox "Operação realizada com sucesso!", vbInformation, "Gravação"
    
End Sub
Espero ter ajudado.

Abs


Saulo

Remember when you were young?
You shone like the sun.
Shine On You Crazy Diamond


Se suas dúvidas foram esclarecidas, acrescente ao lado do título o texto [RESOLVIDO].

Responder