Option Explicit

Public Const MOVEUP     As Byte = 1
Public Const MOVEDOWN   As Byte = 2
Public Const MOVETOP    As Byte = 3
Public Const MOVEBOTTOM As Byte = 4

'Ab VB 6 kann auch eine Aufzählung verwendet werden:
' Public Enum enumDirection
'   MoveUp = 1
'   MoveDown = 2
'   MoveTop = 3
'   MoveBottom = 4
' End Enum

Public Sub ListItemsMove(ByVal lstSource As ListBox, _
      ByVal lstDestination As ListBox)
'Einträge zwischen den ListBoxen verschieben

  On Error Resume Next

  Dim lngCounter As Long

  With lstDestination
    For lngCounter = (lstSource.ListCount - 1) To 0 Step -1
      If lstSource.Selected(lngCounter) = True Then
        .AddItem lstSource.List(lngCounter)
        .ItemData(.NewIndex) = lstSource.ItemData(lngCounter)

        lstSource.RemoveItem (lngCounter)
      End If
    Next lngCounter
  End With

  Set lstSource = Nothing
  Set lstDestination = Nothing
End Sub

Public Sub ListItemsOrder(ByVal lstListBox As ListBox, _
      ByVal varDirection As Byte)

'Ab VB 6 kann auch eine Aufzählung verwendet werden:
' Public Sub ListItemsOrder(ByRef lstListBox As ListBox, _
'       ByVal varDirection As enumDirection)

'Einträge in der ListBox nach oben/unten verschieben

  On Error Resume Next

  Dim lngCounter As Long

  Dim blnMove As Boolean
  Dim lngDone As Long

  With lstListBox
    Select Case varDirection
      Case MOVEUP
        For lngCounter = 0 To (.SelCount - 1)
          If .Selected(lngCounter) = False Then
            blnMove = True
            Exit For
          End If
        Next lngCounter

        If blnMove Then
          For lngCounter = 1 To (.ListCount - 1)
            If .Selected(lngCounter) Then
              .AddItem .List(lngCounter), (lngCounter - 1)
              .ItemData(.NewIndex) = .ItemData(lngCounter + 1)
              .Selected(.NewIndex) = True
              .RemoveItem (lngCounter + 1)
            End If
          Next lngCounter
        End If

      Case MOVEDOWN
        For lngCounter = (.ListCount - .SelCount) To _
            (.ListCount - 1)
          If .Selected(lngCounter) = False Then
            blnMove = True
            Exit For
          End If
        Next lngCounter

        If blnMove Then
          For lngCounter = (.ListCount - 2) To 0 Step -1
            If .Selected(lngCounter) Then
              .AddItem .List(lngCounter), (lngCounter + 2)
              .ItemData(.NewIndex) = .ItemData(lngCounter)
              .Selected(.NewIndex) = True
              .RemoveItem (lngCounter)
            End If
          Next lngCounter
        End If

      Case MOVETOP
        For lngCounter = 0 To (.ListCount - 1)
          If .Selected(lngCounter) Then
            .AddItem .List(lngCounter), lngDone
            .ItemData(.NewIndex) = .ItemData(lngCounter + 1)
            .Selected(.NewIndex) = True
            .RemoveItem (lngCounter + 1)

            lngDone = lngDone + 1
          End If
        Next lngCounter

      Case MOVEBOTTOM
        For lngCounter = (.ListCount - 1) To 0 Step -1
          If .Selected(lngCounter) Then
            .AddItem .List(lngCounter), (.ListCount - lngDone)
            .ItemData(.NewIndex) = .ItemData(lngCounter)
            .Selected(.NewIndex) = True
            .RemoveItem lngCounter

            lngDone = lngDone + 1
          End If
        Next lngCounter

    End Select

    .SetFocus
  End With
End Sub