Deplacer Item dans une listbox

[Phil]

Bonjour le forum,

J'ai un petit soucis ou plutot un petit besoin qui m'aiderait a faire plus propre ma macro :
J'ai un USF tout simple avec une listbox et un bouton,

Private Sub UserForm_Initialize()
Dim cel As Range

For Each cel In Sheets('temp').Range('AC1:AC17')
If cel <> '' Then
ListBox1.AddItem cel
End If
Next cel

End Sub

une fois les item recuperé j'aimerai si c'est possible que l'utilisateur puisse réorganiser les items comme il le souhaite en les deplacant vers le haut ou le bas et ensuite valide sur le bouton et ca renverrai les items dans les cellules 'classé' dans le bon ordre
Es-ce possible ?

Merci d'avance de votre interet et de vos réponses

 

[MichelXld]

bonjour Phil

le 1er exemple deplace l'item d'un index vers le haut lorsque l'on clique dessus

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Cible As Integer

On Error Resume Next

With ListBox1
If .ListIndex < 0 Then Exit Sub
Cible = .ListIndex
If Cible = 0 Then Exit Sub
.AddItem .Text, Cible - 1
.RemoveItem Cible + 1
.Selected(Cible - 1) = True
End With

End Sub


2eme exemple
le premier doubleclick enregistre l'item de la ListBox dans une variable , puis supprime la ligne
le second DoubleClick insère la variable en mémoire à l'emplacement du curseur

Dim Cible As Boolean
Dim Valeur As String
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

If Cible = False Then
Cible = True
Valeur = ListBox1
ListBox1.RemoveItem ListBox1.ListIndex
Else
Cible = False
ListBox1.AddItem Valeur, ListBox1.ListIndex + 1
End If

End Sub


bonne soiree
MichelXld

 

[Phil]

Meric pour ta réponse MichelXld

En utilisant ton code, j'ai finalement opter pour un spinboutton pour monter decendre...
Je poses le résultat (peut-etre un peu barbare, suis un peu newb)
si ca peut servir a quelqu'un ou si tu penses qu'il doit etre un peu modifier

Private Sub SpinButton1_SpinDown()

Dim Valeur As String

On Error GoTo Err

If ListBox1.ListIndex = '-1' Then
MsgBox 'Vous n'avez pas séléectionné de ligne'
Exit Sub
End If

Valeur = ListBox1

ListBox1.RemoveItem ListBox1.ListIndex

ListBox1.AddItem Valeur, ListBox1.ListIndex + 1

ListBox1.Selected(ListBox1.ListIndex + 1) = True

Err: Exit Sub


End Sub

Private Sub SpinButton1_SpinUp()

Dim Valeur As String

On Error GoTo Err

Valeur = ListBox1

ListBox1.RemoveItem ListBox1.ListIndex

ListBox1.AddItem Valeur, ListBox1.ListIndex - 1

ListBox1.Selected(ListBox1.ListIndex - 2) = True

Err: Exit Sub

End Sub

en tout cas merci pour ton aide

A plus le forum