'Esto debes colocarlo al principio del modulo, justo debajo de

'Option Compare Database y Option Explicit (si está)

Public Enum Direc

Subir

Bajar

End Enum

'Esto en cualquier lugar del módulo

'**********************************************************************************************

'* Function SubeBajaLista

'* Mueve un elemento del cuadro de lista (Lista de Valores) pasado como paramentro (Lista) a la

' posición inmediatamente anterior o posterior de acuerdo con el parámentro Direccion

'* Argumentos: frm => Ojeto que hace referencia al form en el que se encuentran las listas

' Lista => Nombre (texto) del cuadro de lista sobre el que actuaremos entre ""

' Direccion => Subir o Bajar indica en que dirección moveremos el elemento

' no es necesario usar comillas, es una enumeración de un tipo

' definido por el usuario (Gracias a Emilio Sancha) por este detalle.

'* Uso: Call SubeBajaLista(Me, "NombreLista", Subir o Bajar)

'* Marciano Almohalla, Diciembre 2005

'**********************************************************************************************

Function SubeBajaLista(frm As Form, Lista As String, Direccion As Direc)

'Con este codigo vamos a mover la opción que se encuentre seleccionada

'en el listbox, a la posición inmediatamente anterior o posterior

'Como el listbox tiene como origen de datos una lista de valores

'para poderlos ordenar creamos una Matriz y la cargamos con los valores

'del listbox

Dim arrayLista() As Variant

Dim i As Integer

Dim mLista As String

Dim iSel As Variant

'Guardamos la posición ordinal de la opcion que se encuentra

'seleccionada en el listbox en la variable iSel

For i = 0 To frm.Controls(Lista).ListCount - 1

If frm.Controls(Lista).Selected(i) = True Then

iSel = i

Exit For

End If

Next i

'Si iSel es 0, es que estamos en el primer registro y

'por lo tanto no podemos subir mas

If iSel = 0 And Direccion = Subir Then Exit Function

'Si estamos en el ultimo registro ya no se puede bajar mas

If iSel = frm.Controls(Lista).ListCount - 1 And Direccion = Bajar Then Exit Function

'Redimensionamos la Matriz para que admita un numero de valores

'igual al de elementos que hay en el listbox

ReDim arrayLista(frm.Controls(Lista).ListCount)

'Rellenamos la Matriz recorriendo la lista de valores

For i = 0 To frm.Controls(Lista).ListCount

arrayLista(i) = frm.Controls(Lista).ItemData(i)

Next i

'Rellenamos una variable string con los valores reordenados

'Diferenciamos según queramos subir o bajar

If Direccion = Subir Then

'Añadimos a la lista todos los valores anteriores a los dos afectados

For i = 0 To iSel - 2

mLista = mLista & arrayLista(i) & ";"

Next i

'a continuacion ponemos el valor a mover, con lo cual ya ha subido un puesto

mLista = mLista & arrayLista(iSel) & ";"

'ahora colocamos el que baja ese puesto

mLista = mLista & arrayLista(iSel - 1) & ";"

'y aquí el resto hasta completar la lista de valores

For i = iSel + 1 To frm.Controls(Lista).ListCount

mLista = mLista & arrayLista(i) & ";"

Next i

ElseIf Direccion = Bajar Then

'Añadimos a la lista todos los valores anteriores a los dos afectados

For i = 0 To iSel - 1

mLista = mLista & arrayLista(i) & ";"

Next i

'ahora colocamos el valor que sube

mLista = mLista & arrayLista(iSel + 1) & ";"

'y el valor que baja

mLista = mLista & arrayLista(iSel) & ";"

'y po fin el resto de los valores

For i = iSel + 2 To Me.CamposMostrados.ListCount

mLista = mLista & arrayLista(i) & ";"

Next i

Else

'Si direccion no es ni "Subir" ni "Bajar", hay un error en la llamada, asi que abortamos

MsgBox "Parámetro no válido, debe indicar Subir o Bajar para el parametro Direccion", vbOKOnly + vbCritical, "ERROR"

Exit Function

End If

'quitamos el ultimo ; que generaria una opcion "" en el listbox

mLista = Left(mLista, Len(mLista) - 1)

'asignamos el valor de esta variable al cuadro de lista, de esta

'forma ya lo tendremos reordenado

frm.Controls(Lista).RowSource = mLista

'Marcamos como seleccionada la opcion que acabamos de mover

If Direccion = Subir Then

frm.Controls(Lista).Selected(iSel - 1) = True

Else

frm.Controls(Lista).Selected(iSel + 1) = True

End If

End Function