Spinbutton + listbox + feuille = ça marche MAIS ...

[ketinu]

Bonjour à tous, Bonjour M. Le Forum,

Voilà, j'ai récupéré un programme de modification de position dans une listbox via des spinbuttons. Cela marche à merveille sur les cellules en A mais je n'arrive pas à lui dire de bouger toute la ligne de la cellule !

Cela ne doit pas être bien compliqué pour ce forum alors je relève le niveau ^^ :

Il faudrait que lors du déplacement, les mêmes items (liste 1) restent ensemble !
Petit schéma:
Liste 1 Liste 2 Liste 3
Item 1 product 1 num 1
Item 1 product 8 num 8
Item 2 product 2 num 2
Item 3 product 3 num 3
Item 4 product 4 num 4
Item 5 product 5 num 5
Item 6 product 6 num 6
Item 7 product 7 num 7

Si je déplace ITEM 1 en dessous de ITEM 4, cela devrait donner :

Liste 1 Liste 2 Liste 3
Item 2 product 2 num 2
Item 3 product 3 num 3
Item 4 product 4 num 4
Item 1 product 1 num 1
Item 1 product 8 num 8
Item 5 product 5 num 5
Item 6 product 6 num 6
Item 7 product 7 num 7

Tout en me permettant si je le souhaite de déplacer cette ligne : Item 1 product 8 num 8 AU DESSUS (ou en dessous) de cette ligne Item 1 product 1 num 1


De même, s'il existe plusieurs fois le même produit (liste2) pour le même item(liste1), alors il doit me permettre de pouvoir modifier l'ordre du num (liste3)

Liste 1 Liste 2 Liste 3
Item 1 product 1 num 1
Item 1 product 1 num 8
Item 2 product 2 num 2
Item 3 product 3 num 3
Item 4 product 4 num 4
Item 5 product 5 num 5
Item 6 product 6 num 6
Item 7 product 7 num 7

Liste 1 Liste 2 Liste 3
Item 1 product 1 num 8
Item 1 product 1 num 1
Item 2 product 2 num 2
Item 3 product 3 num 3
Item 4 product 4 num 4
Item 5 product 5 num 5
Item 6 product 6 num 6
Item 7 product 7 num 7

Je vous joint le fichier.
N'hésitez pas si je n'ai pas été assez clair.
Merci à tous pour votre aide !
Et vive Excel

 

[jp14]

Re : Spinbutton + listbox + feuille = ça marche MAIS ...

Bonjour

Ci joint un code qui gère la listbox, on sélectionne l'item et avec le spinbutton on déplace l'élément dans la listbox. Cela permet dans un remier temps de regrouper les items.

Pour faire la mise à jour de la feuille il suffit de transférer la listbox dans la feuille ( à écrire)

Option Explicit
Option Base 0
Dim index1 As Integer
Dim flag As Boolean
Private Sub ListBox_Items_Click()
If flag = True Then Exit Sub
With ListBox_Items
If .ListIndex = -1 Then Exit Sub
index1 = .ListIndex + 1
SpinButton1 = .ListIndex
End With
End Sub

Private Sub UserForm_Activate()
    populateBox 'populates listbox on load
    flag = False
End Sub

Private Sub SpinButton1_SpinDown()
deplacer
End Sub
Private Sub SpinButton1_SpinUp()
 If SpinButton1 = 0 And index1 = 1 Then Exit Sub
deplacer
End Sub
Private Sub deplacer()
    Dim i As Long
    Dim tablo() As String
    With ListBox_Items
    ReDim tablo(.ColumnCount - 1)
    flag = True
'reorganisation de la listbox
'on permute deux éléments de la listbox
 If index1 = 0 Then Exit Sub
 'sauvegarde
 For i = 0 To .ColumnCount - 1
    tablo(i) = .List(index1 - 1, i)
 Next i
 ' transfert
    .List(index1 - 1, 0) = .List(SpinButton1.Value, 0)
    .List(index1 - 1, 1) = .List(SpinButton1.Value, 1)
    .List(index1 - 1, 2) = .List(SpinButton1.Value, 2)
    .List(index1 - 1, 3) = .List(SpinButton1.Value, 3)
    .List(index1 - 1, 4) = .List(SpinButton1.Value, 4)
 ' ecriture
    .List(SpinButton1.Value, 0) = tablo(0)
    .List(SpinButton1.Value, 1) = tablo(1)
    .List(SpinButton1.Value, 2) = tablo(2)
    .List(SpinButton1.Value, 3) = tablo(3)
    .List(SpinButton1.Value, 4) = tablo(4)
    index1 = SpinButton1.Value + 1
    .ListIndex = SpinButton1.Value
End With
flag = False
End Sub


Public Sub populateBox()
    Dim cell As Range
    Dim i As Integer
With ListBox_Items
    .Clear
    .ColumnCount = 5
    .ColumnWidths = "50;50;50;0;0"
    'change to location of your list

        If Sheets("ListHolder").UsedRange.Rows.Count > 1 Then
            i = 0
            For Each cell In Sheets("ListHolder").Range(Sheets("ListHolder").Cells(2, 1), Sheets("ListHolder").Cells(Sheets("ListHolder").UsedRange.Rows.Count, 1))
            'For Each cell In .Range(.Cells(2, 1), .Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
                ListBox_Items.AddItem cell
                .List(i, 1) = cell.Offset(0, 1).Value
                .List(i, 2) = cell.Offset(0, 2).Value
                .List(.ListCount - 1, .ColumnCount - 2) = cell.Row
                .List(.ListCount - 1, .ColumnCount - 1) = ""
                i = i + 1
            Next cell
        End If
    SpinButton1.Min = 0
    SpinButton1.Max = .ListCount - 1
    'SpinButton1.Value = 1
    End With
End Sub

Private Sub CommandButton_Save_Click()
    'optional; ensures changes to order of list are saved
    ThisWorkbook.Save
    Unload Me
End Sub

Private Sub CommandButton_Cancel_Click()
    Unload Me
End Sub

A tester.

 

[ketinu]

Re : Spinbutton + listbox + feuille = ça marche MAIS ...

Hello jp14,

Ton code fonctionne mais malheureusement il ne prend pas en compte la ligne entière. Il est vrai que dans l'exemple cela ne semble pas nécessaire, mais par la suite des centaines de données seront ajoutées dans les colonnes qui suivent.
Est-ce alors possible de gérer ça ?

Merci

 

[jp14]

Re : Spinbutton + listbox + feuille = ça marche MAIS ...

Bonjour

On peut toujours rajouter des colonnes dans la listbox et avec le code suivant on ne s'occupe pas du nombre de colonne.

Pour appeler la procédure



Private Sub deplacer()
    Dim i As Long
    Dim tablo() As String
    With ListBox_Items
    ReDim tablo(.ColumnCount - 1)
    flag = True
'reorganisation de la listbox
'on permute deux éléments de la listbox
 'sauvegarde
If index1 = 0 Then Exit Sub
For i = 0 To .ColumnCount - 1
    tablo(i) = .List(index1 - 1, i)
 Next i
' transfert
For i = 0 To .ColumnCount - 1
     .List(index1 - 1, i) = .List(SpinButton1.Value, i)
Next i
 ' ecriture
For i = 0 To .ColumnCount - 1
    .List(SpinButton1.Value, i) = tablo(i)
Next i
'on positionne les index
   index1 = SpinButton1.Value + 1
    .ListIndex = SpinButton1.Value
End With
flag = False
End Sub

Le code pour déplacer deux items est nettement plus complexe car la procédure
"Private Sub ListBox_Items_Click()" ne fonctionne pas, et on ne peut jouer avec les spinsboutons.
Il y aura un impératif, les items devront être adjacents.


JP

 

[ketinu]

Re : Spinbutton + listbox + feuille = ça marche MAIS ...

Bonsoir et merci d'avoir répondu !

Le programme est bien mais ne satisfait malheureusement pas mes attentes ...
Je viens de penser, n'est-il pas possible de couper la ligne et de l'insérer à la nouvelle place choisie ?

 

[jp14]

Re : Spinbutton + listbox + feuille = ça marche MAIS ...

Bonsoir

Ci joint le fichier avec la listbox.
En sélectionnant un élément ou plusieurs on peut les déplacer dans la listbox.
Les éléments sélectionnés doivent être consécutifs.

"Cela ne doit pas être bien compliqué pour ce forum alors je relève le niveau"

Pour comprendre le fonctionnement, il faut à l'aide d'un espion suivre le contenu des variables.


A tester, et à compléter, en particulier pour l'écriture dan la feuille

JP

 

[ketinu]

Re : Spinbutton + listbox + feuille = ça marche MAIS ...

Merci jp14 !
Mais je désespère ! Je ne comprends fichtrement rien alors même que tu me mâches le boulot. Je n'arrive même pas à affecter ma feuille des déplacements de la listbox ...
Aurais-tu une corde ?

 

[jp14]

Re : Spinbutton + listbox + feuille = ça marche MAIS ...

Bonsoir

Ci dessous le nouveau code pour gérer les SpinButtons.
Il évite des messages d'erreur.

Private Sub SpinButton1_SpinDown()
' monter

Dim i As Long
Dim j As Long
With ListBox_Items

'If .ListIndex = -1 Then Exit Sub
    For i = .ListCount - 1 To 0 Step -1
        If .Selected(i) = True Then j = j + 1
    Next i
    If j = 0 Then j = 1
    ReDim index1(j - 1)
    j = 0
    For i = 0 To .ListCount - 1 'Step -1
        If .Selected(i) = True Then
           [COLOR="red"] If i = 0 Then Exit Sub[/COLOR]
            index1(j) = i
            j = j + 1
        End If
    Next i
' on supprime la multisection et on positionne la listbox
    .MultiSelect = 0
    For j = LBound(index1) To UBound(index1) 'Step -1
        If index1(j) - 1 >= 0 Then
            Call deplacer(index1(j), index1(j) - 1)
        End If
    Next j

           .ListIndex = -1
           .MultiSelect = 1
' on rétabli la sélection
    For j = LBound(index1) To UBound(index1) 'Step -1
        If index1(j) - 1 >= 0 Then
            .Selected(index1(j) - 1) = True
        End If
    Next j
End With
End Sub



Private Sub SpinButton1_SpinUp()
' descendre les items incrémenter le compteur
Dim i As Long
Dim j As Long
With ListBox_Items

'If .ListIndex = -1 Then Exit Sub
    For i = .ListCount - 1 To 0 Step -1
        If .Selected(i) = True Then j = j + 1
    Next i
    If j = 0 Then j = 1
    ReDim index1(j - 1)
    j = 0
    For i = .ListCount - 1 To 0 Step -1
        
        If .Selected(i) = True Then
           [COLOR="red"] If i = .ListCount - 1 Then Exit Sub[/COLOR]
            index1(j) = i
            j = j + 1
        End If
    Next i
' on supprime la multisection et on positionne la listbox
    .MultiSelect = 0
    For j = LBound(index1) To UBound(index1) 'Step -1
        Call deplacer(index1(j), index1(j) + 1)
    Next j
           .ListIndex = -1
           .MultiSelect = 1
' on rétabli la sélection
    For j = LBound(index1) To UBound(index1) 'Step -1
         .Selected(index1(j) + 1) = True
    Next j
End With
End Sub

JP

 

[klin89]

Re : Spinbutton + listbox + feuille = ça marche MAIS ...

Bonsoir à tous,
Bonsoir jp14, ketinu

Si cela peut vous aider voir la listbox de Chip Pearson dans le fichier joint.

Klin89