ListBox com multiseleção, gravando em um array
Enviado: 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
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