Private Sub cmdUp_Click()
On Error Resume Next
Dim nItem As Integer
With lstSelected
If .ListIndex < 0 Then Exit Sub
nItem = .ListIndex
If nItem = 0 Then Exit Sub '不能将第一个项目向上移动
'向上移动项目
.AddItem .Text, nItem - 1
'删除旧的项目
.RemoveItem nItem + 1
'选择刚刚被移动的项目
.Selected(nItem - 1) = True
End With
End Sub
Private Sub cmdDown_Click()
On Error Resume Next
Dim nItem As Integer
With lstSelected
If .ListIndex < 0 Then Exit Sub
nItem = .ListIndex
If nItem = .ListCount - 1 Then Exit Sub '不能将最后的项目向下移动
'向下移动项目
.AddItem .Text, nItem + 2
'删除旧的项目
.RemoveItem nItem
'选择刚刚被移动的项目
.Selected(nItem + 1) = True
End With
End Sub
Private Sub cmdRightOne_Click()
On Error Resume Next
Dim i As Integer
If lstAll.ListCount = 0 Then Exit Sub
lstSelected.AddItem lstAll.Text
i = lstAll.ListIndex
lstAll.RemoveItem lstAll.ListIndex
If lstAll.ListCount > 0 Then
If i > lstAll.ListCount - 1 Then
lstAll.ListIndex = i - 1
Else
lstAll.ListIndex = i
End If
End If
lstSelected.ListIndex = lstSelected.NewIndex
End Sub
Private Sub cmdRightAll_Click()
On Error Resume Next
Dim i As Integer
For i = 0 To lstAll.ListCount - 1
lstSelected.AddItem lstAll.List(i)
Next
lstAll.Clear
lstSelected.ListIndex = 0
End Sub
Private Sub cmdLeftOne_Click()
On Error Resume Next
Dim i As Integer
If lstSelected.ListCount = 0 Then Exit Sub
lstAll.AddItem lstSelected.Text
i = lstSelected.ListIndex
lstSelected.RemoveItem i
lstAll.ListIndex = lstAll.NewIndex
If lstSelected.ListCount > 0 Then
If i > lstSelected.ListCount - 1 Then
lstSelected.ListIndex = i - 1
Else
lstSelected.ListIndex = i
End If
End If
End Sub
Private Sub cmdLeftAll_Click()
On Error Resume Next
Dim i As Integer
For i = 0 To lstSelected.ListCount - 1
lstAll.AddItem lstSelected.List(i)
Next
lstSelected.Clear
lstAll.ListIndex = lstAll.NewIndex
End Sub
Private Sub Form_Load()
lstAll.AddItem "aaa"
lstAll.AddItem "bbb"
lstAll.AddItem "ccc"
lstAll.ListIndex = 0
End Sub
Private Sub lstAll_DblClick()
cmdRightOne_Click
End Sub
Private Sub lstSelected_DblClick()
cmdLeftOne_Click
End Sub
看看这个代码就可以了