如何使列表框中的项上下移动排序?

Question

如何使列表框中的项上下移动排序?

Answer 1

Option Explicit
'上移一行
Private Sub Command1_Click()
   If List1.ListIndex <> 0 Then
      MoveList List1.ListIndex - 1
   End If
End Sub
'"下移一行"
Private Sub Command2_Click()
   If List1.ListIndex < List1.ListCount - 1 Then
      MoveList List1.ListIndex + 1
   End If
End Sub
'"移至行首"
Private Sub Command3_Click()
   MoveList 0
End Sub
'"移至行尾"
Private Sub Command4_Click()
   MoveList List1.ListCount - 1
End Sub'增加4个按扭 一个列表框
Private Sub Form_Load()
   Dim i As Long
   
   For i = 1 To 10
     List1.AddItem "Str" & i
   Next
   
   
   Command1.Caption = "上移一行"
   Command2.Caption = "下移一行"
   Command3.Caption = "移至行首"
   Command4.Caption = "移至行尾"
  
End Sub
Private Function MoveList(ByVal Index As Long)
   Dim Data As String
   Data = List1.Text
   List1.RemoveItem List1.ListIndex
   List1.AddItem Data, Index
   List1.ListIndex = Index
End Function

Answer 2

Option Base 1
Private Sub Command1_Click()
x = List1.ListIndex
If x <= 0 Then Exit Sub
s1 = List1.List(x)
s2 = List1.List(x - 1)
List1.List(x) = s2
List1.List(x - 1) = s1
List1.Selected(x - 1) = True
End Sub
Private Sub Command3_Click() List1.Refresh
End Sub
Private Sub Form_Load()
Dim Arr()
Arr = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z")
For i = 1 To UBound(Arr)
List1.AddItem Arr(i)
Next
End Sub
Private Sub Command2_Click()
j = 0
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then
j = j + 1
Else
j = j + 0
End If
Next
If j = 0 Then Exit Sub
x = List1.ListIndex
If x < List1.ListCount - 1 Then
s1 = List1.List(x)
s2 = List1.List(x + 1)
List1.List(x) = s2
List1.List(x + 1) = s1
List1.Selected(x + 1) = True
Else
Exit Sub
End If
End Sub

Answer 3

Option Explicit
'上移一行
Private Sub Command1_Click()
   If List1.ListIndex <> 0 Then
      MoveList List1.ListIndex - 1
   End If
End Sub
'"下移一行"
Private Sub Command2_Click()
   If List1.ListIndex < List1.ListCount - 1 Then
      MoveList List1.ListIndex + 1
   End If
End Sub
'"移至行首"
Private Sub Command3_Click()
   MoveList 0
End Sub
'"移至行尾"
Private Sub Command4_Click()
   MoveList List1.ListCount - 1
End Sub'增加4个按扭 一个列表框
Private Sub Form_Load()
   Dim i As Long
   
   For i = 1 To 10
     List1.AddItem "Str" & i
   Next
   
   
   Command1.Caption = "上移一行"
   Command2.Caption = "下移一行"
   Command3.Caption = "移至行首"
   Command4.Caption = "移至行尾"
  
End Sub
Private Function MoveList(ByVal Index As Long)
   If List1.ListIndex < 0 Then Exit Function  '增加这个判断,如果未选中则不进行移动.
   Dim Data As String
   Data = List1.Text
   List1.RemoveItem List1.ListIndex
   List1.AddItem Data, Index
   List1.ListIndex = Index
End Function