Amigo fiz aqui um exemplo comentado para vc:
'Códifo fonte do form:
Private Sub Command1_Click()
' Verifica se o item selecionado é maior do que 0, ou seja, ao menos o
' segundo item do list2, porque não dá para mover o primeiro item para cima.
If List2.ListIndex > 0 Then
Dim i As Integer
Dim txt As String
' Como vou ter que substituir valores do list, tenho que jogar
' um deles para variáveis auxiliares antes de perder seu valor
i = List2.ItemData(List2.ListIndex)
txt = List2.List(List2.ListIndex)
' Aqui eu pego os dados do item mais acima e jogo no item selecionado
' para que eu possa trocá-los de lugar - como eu salvei os dados
' em variáveis auxiliares, posso sobrepô-los sem problemas
List2.List(List2.ListIndex) = List2.List(List2.ListIndex - 1)
List2.ItemData(List2.ListIndex) = List2.ItemData(List2.ListIndex - 1)
' Agora eu coloco os dados auxiliares na linha mais acima.
List2.List(List2.ListIndex - 1) = txt
List2.ItemData(List2.ListIndex - 1) = i
' Troco as seleções para que ela acompanhe o item selecionado inicialmente.
List2.Selected(List2.ListIndex) = False
List2.Selected(List2.ListIndex - 1) = True
End If
End Sub
Private Sub Command2_Click()
' Verifica se tem um item selecionado e então verifica se o item selecionado
' é ao menos o penúltimo, porque o ultimo não pode ser movido mais para baixo
If List2.ListIndex > -1 And List2.ListIndex < List2.ListCount - 1 Then
Dim i As Integer
Dim txt As String
' Como vou ter que substituir valores do list, tenho que jogar
' um deles para variáveis auxiliares antes de perder seu valor
i = List2.ItemData(List2.ListIndex)
txt = List2.List(List2.ListIndex)
' Aqui eu pego os dados do item mais abaixo e jogo no item selecionado
' para que eu possa trocá-los de lugar - como eu salvei os dados
' em variáveis auxiliares, posso sobrepô-los sem problemas
List2.List(List2.ListIndex) = List2.List(List2.ListIndex + 1)
List2.ItemData(List2.ListIndex) = List2.ItemData(List2.ListIndex + 1)
' Agora eu coloco os dados auxiliares na linha mais abaixo.
List2.List(List2.ListIndex + 1) = txt
List2.ItemData(List2.ListIndex + 1) = i
' Troco as seleções para que ela acompanhe o item selecionado inicialmente.
List2.Selected(List2.ListIndex) = False
List2.Selected(List2.ListIndex + 1) = True
End If
End Sub
Private Sub Form_Load()
' --------------------------------
' Este código adicionar no list1 qdo carregar o form ele coloca um conteúdo:AAAA, BBBBB, CCCCC.....
List1.AddItem "AAAAA"
List1.ItemData(List1.NewIndex) = 1
List1.AddItem "BBBBB"
List1.ItemData(List1.NewIndex) = 2
List1.AddItem "CCCCC"
List1.ItemData(List1.NewIndex) = 3
List1.AddItem "DDDDD"
List1.ItemData(List1.NewIndex) = 4
List1.AddItem "EEEEE"
List1.ItemData(List1.NewIndex) = 5
List1.AddItem "FFFFF"
End Sub
Private Sub btnPassAllItem_Click()
' Para passar todo o conteúdo de um List para outro, você tem
' que percorrer o List e jogar item a item para o outro. Como
' você preencheu o ItemData também, é necessário que você mande o ItemData
' para o outro list também
Dim i As Integer
For i = 0 To List1.ListCount - 1
List2.AddItem List1.List(i)
' Eu uso a propriedade NewIndex aqui porque ela sempre
' terá o valor do último indice adicionado, então fica
' mais fácil para atribuir um valor para o itemdata
List2.ItemData(List2.NewIndex) = List1.ItemData(i)
Next
' Terminado o processo, como movemos tudo, a gente pode apagar
' o List que foi a fonte dos dados:
List1.Clear
End Sub
Private Sub btnUndAllItem_Click()
' É o mesmo processo da sub acima, só que invertendo os lists...
Dim i As Integer
For i = 0 To List2.ListCount - 1
List1.AddItem List2.List(i)
List1.ItemData(List1.NewIndex) = List2.ItemData(i)
Next
' Terminado o processo, como movemos tudo, a gente pode apagar
' o List que foi a fonte dos dados:
List2.Clear
End Sub
Private Sub List1_Click()
' Como você só quer habilitar o botão para passar os selecionados
' se houver alguém selecionado efetivamente, aqui nós vamos habilitar o botão.
' Este evento vai ocorrer quando alguém selecionar algo no List1.
If List1.ListIndex > -1 Then
btnPassItem.Enabled = True
End If
End Sub
Private Sub btnPassItem_Click()
' Quando alguém selecionar algo no List1, este botão é habilitado. Como você
' quer permitir multipla seleção, você vai ter que percorrer item a item no List
' para descobrir quem está selecionado.
' Não vai dar para ir apagando item a item, daria erro. Vamos ter que guardar
' os indices dos itens selecionados numa coleção para apagar posteriormente.
' Este array vai ter os indices que vamos apagar
' depois de preencher o list2....
Dim apagar() As Integer
Dim i As Integer
Dim j As Integer
Dim qtd As Integer
ReDim apagar(List1.SelCount)
qtd = 0
' Como disse, precisamos percorrer o controle item a item para
' descobrir quem está selecionado...
For i = 0 To List1.ListCount - 1
' É assim que a gente descobre quem está selecionado, pelo método
' Selected. Se o indice estiver selecionado, ele devolve true, aí
' a gente sabe que este cara tem que ir para o outro List...
If List1.Selected(i) Then
List2.AddItem List1.List(i)
List2.ItemData(List2.NewIndex) = List1.ItemData(i)
' Como disse, não dá para apagar este item aqui. Eu teria um
' erro no for, porque a quantidade de itens diminuíria em 1
' mudando o indice dos itens. Então eu só vou guardar no array
' o dado do item para apagar depois na saída do for.
apagar(qtd) = List1.ItemData(i)
qtd = qtd + 1
End If
Next
' Aqui nós percorremos o array e vamos
' apagando todo mundo que passou para o outro List
For i = 0 To qtd - 1
' Vou procurar pelo item...
For j = 0 To List1.ListCount - 1
' Quando encontrá-lo eu o apago
If List1.ItemData(j) = apagar(i) Then
List1.RemoveItem j
' como já apaguei o item, forço a saída do form
' para procurar o próximo item do array.
Exit For
End If
Next
Next
' E como você não quer que o usuário possa clicar no botão novamente,
' vamos desmarcar a seleção corrente e tornar o botão desabilitado
' até que ele selecione outra coisa...
End Sub
Private Sub List2_Click()
' É o mesmo que eu comentei para o list1 aqui no list2, só que desta vez com o botão
' de volta....
If List2.ListIndex > -1 Then
btnUndItem.Enabled = True
End If
End Sub
Private Sub btnUndItem_Click()
' É o mesmo que eu comentei para o botão que passa os items...
Dim apagar() As Integer
Dim i As Integer
Dim j As Integer
Dim qtd As Integer
ReDim apagar(List2.SelCount)
qtd = 0
For i = 0 To List2.ListCount - 1
If List2.Selected(i) Then
List1.AddItem List2.List(i)
List1.ItemData(List1.NewIndex) = List2.ItemData(i)
apagar(qtd) = List2.ItemData(i)
qtd = qtd + 1
End If
Next
For i = 0 To qtd - 1
For j = 0 To List2.ListCount - 1
If List2.ItemData(j) = apagar(i) Then
List2.RemoveItem j
Exit For
End If
Next
Next
End Sub
' Este método vai deixar os botões individuais desabilitados, limpar as seleções
Private Sub btnSave_Click()
On Error GoTo ErrHandler
' Eu acho que aqui é o melhor ponto para limpar o banco também e então
' gravar os dados novos no banco. Se você quiser mudar o delete de posição
' para outro evento, é só esta linha aqui e mais nada para apagar os dados
' da tabela:
' ---------- Comentado -----------
' não posso apagar o que está na tabela se você precisa recuperar o
' que está salvo, vou apagar só o grupo mais embaixo no if, se for gravar a
' selecao
' cnACN.Execute "Delete From Item_Grupo_Fornecedor"
' Isso aqui é só para ver se está tudo ok e dar uma mensagem de erro
' para o usuário caso não esteja:
If cmbGrupo.ListIndex = -1 Then
MsgBox "Por favor, selecione um grupo"
cmbGrupo.SetFocus
End If
If List2.ListCount = 0 Then
MsgBox "Por favor, selecione os itens na lista"
End If
' Você pode até pedir confirmação para o usuário:
If MsgBox("Confirma gravação?", vbQuestion + vbYesNo, "Exemplo") = vbYes Then
cnACN.Execute "Delete From Item_Grupo_Fornecedor Where Codigo_Grupo_Fornecedor = " & cmbGrupo.ItemData(cmbGrupo.ListIndex)
' Aí em seguida o que eu estou gravando aqui é o seguinte:
' Vou gravar tantas linhas quantos itens foram selecionados no List2. Os dados
' são:
o número que está no ItemData
' do item selecionado no Combo
' Codigo_Grupo_Peca : O código do item no List2, o que está no ItemData do List2
' como são vários itens, cada linha na tabela vai ter o código
' de um item
' Ordenacao : A posição do item no List2, contando a partir do número 1a
Dim i As Integer
For i = 0 To List2.ListCount - 1
cnACN.Execute "Insert Into Item_Grupo_Fornecedor(Codigo_Grupo_Fornecedor, Codigo_Grupo_Peca, Ordenacao) Values (" & cmbGrupo.ItemData(cmbGrupo.ListIndex) & ", " & List2.ItemData(i) & ", " & i + 1 & ")"
Next
End If
Exit Sub
ErrHandler:
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub Form_Unload(Cancel As Integer)
' Isso aqui você esquece, estou só fechando o banco de dados...
cnACN.Close
Set cnACN = Nothing
End Sub
Private Sub cmdBanco_Click()
On Error GoTo ErrHandler
' Isso aqui é só para eu lhe listar o que foi gravado no banco, não precisa
' disso na sua tela. É só um teste para você ver o que foi gravado....
Dim rs As New Recordset
rs.Open "Select Codigo_Grupo_Fornecedor, Codigo_Grupo_Peca, Ordenacao From Item_Grupo_Fornecedor Where Codigo_Grupo_Fornecedor = " & cmbGrupo.ItemData(cmbGrupo.ListIndex) & " Order By Codigo_Grupo_Fornecedor, Ordenacao", cnACN, adOpenForwardOnly
While Not rs.EOF
MsgBox rs(0) & " - " & rs(1) & " - " & rs(2)
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Exit Sub
ErrHandler:
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical
End Sub
'Códifo fonte do módulo
' Cara, não se preocupe com o que está aqui, deve ser diferente aí
' Eu preciso de uma conexão com um banco de dados para apagar e gravar os
' dados, então fiz isso aqui. Criei uma conexão, abro ela ao abrir o sistema e
' encerro ao fechar o form lá.
' É a conexão que faz a ponte entre o aplicativo e o banco de dados. Para poder
' simular algo como seu ambiente criei um banco em access para acessá-lo. Aí a base
' deve ser outra e tal então a string de conexão deve ser diferente e tudo o mais
' mas não faz diferença no exemplo.
' Como imagino ser seu caso, a conexão é aberta e permanece assim até que o
' sistema se encerre, então não tem muito com o que se preocupar...
Public cnACN As ADODB.Connection
Public Sub Main()
Set cnACN = New ADODB.Connection
cnACN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "list.mdb;"
Form1.Show
End Sub
******Cria o banco de Dados...qq coisa me avisa...
abraço