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

'* Function MoveList

'* Mueve un elemento de ListaOrigen a ListaDestino en Cuadros de Lista con la

' propiedad tipo de origen de la fila = Lista de Valores

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

' listaOrigen => Nombre (texto) del cuadro de lista Origen

' listaDestino => Nombre (texto) del cuadro de lista de Destino

'* uso: Call MoveList(Me, "NombreListaOrigen", "NombreListaDestino)

' Call MoveList(Forms!NombreForm!NombreSubForm.Form, "NombreListaOrigen", "NombreListaDestino")

'* Marciano Almohalla, Diciembre 2005

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

Function MoveList(frm As Form, listaOrigen As String, listaDestino As String)

'Primero guardamos en una variable el número de la opción seleccionada

'así podremos voler a dejar seleccionada la opción que ocupe su lugar

'una vez movida esta al otro listbox.

Dim it As Variant, i As Integer

'El bucle se hace hasta listcount -1 porque los valores en el listbox

'comienzan por el 0, por lo que el maximo indice de valor será listcount -1

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

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

it = i

Exit For

End If

Next i

'Añadir y quitar filas a los cuadros de lista, sería mas facil con Additem, pero he

'querido hacerlo de forma que funcione en versiones anteriores que no tienen este metodo

Dim posFila As Integer, posI As Integer, posF

'Comprobamos que halla filas seleccionadas para añadir

If frm.Controls(listaOrigen).ItemsSelected.Count > 0 Then

Dim it2 As Variant

Dim Seleccionados As String

'Recorremos la coleccion de opciones seleccionadas en el cuadro de lista

'y las vamos guardando en una variable de texto separadas por ;

For Each it2 In frm.Controls(listaOrigen).ItemsSelected

Seleccionados = Seleccionados & frm.Controls(listaOrigen).ItemData(it2) & ";"

Next it2

'Eliminamos el ultimo ;

Seleccionados = Mid(Seleccionados, 1, Len(Seleccionados) - 1)

'Si listaDestino está vacio le asignamos directamente todos los nuevos

If frm.Controls(listaDestino).RowSource = "" Then

frm.Controls(listaDestino).RowSource = Seleccionados

Else

'Si no está vacio, es decir, si ya contiene valores, añadimos los nuevos

frm.Controls(listaDestino).RowSource = frm.Controls(listaDestino).RowSource & ";" & Seleccionados

End If

'Quitamos de ListaOrigen los que hemos pasado a ListaDestino

posI = 1

posF = InStr(1, Seleccionados, ";")

If posF = 0 Then posF = Len(Seleccionados) + 1

'Para ello recorremos la variable que contiene los nombres de todos

'los valores seleccionados (los que hemos pasado) y

Do While posI < Len(Seleccionados)

'Vamos buscando ese valor en el RowSource de ListaOrigen

posFila = InStr(1, frm.Controls(listaOrigen).RowSource, Mid(Seleccionados, posI, posF - posI))

'Eliminamos ese valor del Rowsource, para ello lo rehacemos copiando todos los valores

'anteriores y los posteriores al que queremos quitar

frm.Controls(listaOrigen).RowSource = Mid(frm.Controls(listaOrigen).RowSource, 1, posFila - 1) & _

Mid(frm.Controls(listaOrigen).RowSource, posFila + (posF - posI) + 1)

posI = posF + 1

posF = InStr(posI, Seleccionados, ";")

If posF = 0 Then posF = Len(Seleccionados) + 1

Loop

'Si se nos ha quedado un ; al final lo quitamos para que no nos quede un fila ""

If Left(frm.Controls(listaOrigen).RowSource, 1) = ";" Then

frm.Controls(listaOrigen).RowSource = Mid(frm.Controls(listaOrigen).RowSource, 2)

End If

End If

'Dejamos seleccionado en el listbox la opción que ocupa el lugar de la

'que acabamos de traspasar al listbox ListaDestino

If frm.Controls(listaOrigen).ListCount > it Then

frm.Controls(listaOrigen).Selected(it) = True

End If

End Function