Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Userform Adicionar/...
 
Notifications
Clear all

Userform Adicionar/Remover itens com falha

 
2024 - VBA & Macros
Post Recente por gilbertjrs 8 anos atrás
3 Posts
2 Usuários
0 Reactions
1,032 Visualizações
RSS
 gilbertjrs
(@gilbertjrs)
Posts: 0
New Member
Topic starter
 

Pessoal, boa noite. Estou com o seguinte problema:

Criei um formulário com 2 ListBox:
No ListBox1 ficam os departamentos disponíveis na empresa.
No ListBox2 ficam os departamentos que fazem parte de um contrato.

O departamento comercial deve configurar os itens através de 2 botões exitentes entre os 2 ListBox (um inclui, outro remove itens do ListBox2)

A falha ocorre quando um item selecionado no ListBox2 é removido, devendo retornar ao ListBox1.
Ao retornar para o ListBox1 está ficando um espaço entre os itens anteriores e o movido.

Segue uma planilha que criei para exemplificar o problema apresentado também na outra (lá da empresa).

Grato a quem der um help.

 
Postado : 08/03/2017 9:39 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Se entendi corretamente, o "espaço" deve-se ao fato de no preenchimento inicial do listbox1 estar acrescentando um registro em branco/vazio.
Experimente assim:

Sub AddSetores()
    With ThisWorkbook.Sheets("Departamentos")
        ultLinha = .Cells(Rows.Count, "A").End(xlUp).Row
        For i = 2 To ultLinha - 1
            If .Cells(i, 1).Value <> "Total" Then
                UserForm1.ListBox1.AddItem (.Cells(i, 1).Value)
            End If
        Next
    End With
End Sub
 
Postado : 09/03/2017 3:24 am
 gilbertjrs
(@gilbertjrs)
Posts: 0
New Member
Topic starter
 

Obrigado, era mesmo espaço vazio adicionado no final do ListBox1, alterie meu código

Era

Sub AddSetores()
    
    With ThisWorkbook.Sheets("Departamentos")
        ultLinha = .Cells(Rows.Count, "A").End(xlUp).Row
        For i = 0 To ultLinha - 2
            If .Cells(i + 2, 1).Value <> "Total" Then
                UserForm1.ListBox1.AddItem (.Cells(i + 2, 1).Value)
            End If
        Next
    End With

End Sub

Ficou

Sub AddSetores()
    
    With ThisWorkbook.Sheets("Departamentos")
        ultLinha = .Cells(Rows.Count, "A").End(xlUp).Row
        For i = 0 To ultLinha - 2
            If .Cells(i + 2, 1).Value <> "Total" Then
                UserForm1.ListBox1.AddItem (.Cells(i + 2, 1).Value)
            End If
        Next
    End With

End Sub
 
Postado : 09/03/2017 5:03 am
Forum Jump:
  Tópico Anterior
Próximo Tópico