Vídeo recomendado
https://youtu.be/diWPPPhW-9E

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 »

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
Jedi
Jedi
Mensagens: 805
Registrado em: Qua Mai 06, 2015 7:39 pm

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

Mensagem por srobles »

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


Responder