Échange entre deux ListBox

Version imprimable

1 pièce(s) jointe(s)

Bonjour,
J'ai un souci sur un fichier dont je joins une version allégée pour mon problème.
J'ai un formulaire avec 8 listbox (fmMultiselectsingle). Si je selectionne 1 item sur 2 des listbox, je souhaite simplement échanger ces deux items.
J'arrive bien à vider les listbox et à enregistrer les nouvelles valeurs dans les tableaux de variable, mais seule la premiere listbox cliquée et remplie, la seconde reste vide.

Merci d'avance pour votre aide et désolé pour le code qui suit que je n'arrive pas à indenter dans ce message

Voici le code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 
Private Sub EchangeEntreList()
 Dim Ctl As Control, X1 As String, X2 As String, A As String, B As String
 X = 0
 X1 = ""
 X2 = ""
With UserForm7
    For Each Ctl In .Controls
        If TypeName(Ctl) = "ListBox" Then
            For i = 0 To Ctl.ListCount - 1
                If Ctl.Selected(i) Then X = X + 1
                    Select Case X
                    Case Is = 1
                    If X1 = "" Then
                    X1 = Right(Ctl.Name, 1)
                    End If
                    Case Is = 2
                     If X2 = "" Then
                    X2 = Right(Ctl.Name, 1)
                    End If
                    End Select
            Next i
        End If
    Next Ctl
End With
If X = 2 Then
    With UserForm7
     Dim text1  As String, text2 As String
    t1 = .Controls("ListBox" & X1).List  't1 tableau premiere listbox
    text1 = .Controls("ListBox" & X1).ListIndex  'text1 selection premiere listbox
    t2 = .Controls("ListBox" & X2).List   't2 tableau seconde listbox
    text2 = .Controls("ListBox" & X2).ListIndex  'text2 selection seconde listbox
        For i = 0 To 4
        A = t1(text1, i) 'txt premiere listbox
        B = t2(text2, i) 'txt seconde listbox
        t1(text1, i) = B 'remplacement txt premiere listbox par txt seconde dans tableau
        t2(text2, i) = A 'remplacement txt seconde listbox par txt premiere dans tableau
        Next i
        .Controls("ListBox" & X1).Clear
        .Controls("ListBox" & X1).List = t1
        .Controls("ListBox" & X2).Clear
        .Controls("ListBox" & X2).List = t2
    End With
 
End If
End Sub

2 pièce(s) jointe(s)

Salut.

Si j'ai bien compris, tu souhaites simplement échanger les deux items (pas toute la liste). Il n'y a pas besoin de vider les listes pour cela.

Voici un code qui permet d'échanger deux items. Il considère qu'il y a au moins un item sélectionné dans chaque liste, et j'ai considéré ton besoin initial de sélectionner UN item dans chaque liste (le premier sélectionné). Tu verras que j'ai sorti le code "qui travaille" de l'événement. J'utilise également deux fonctions qui vont permettent de récupérer la première valeur sélectionnée de chaque liste ainsi que sa position. Lorsque ces valeurs sont récupérées pour les deux listes, il suffit de les permuter.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 Option Explicit Private Sub CommandButton1_Click() PermuteValues End Sub Sub PermuteValues() Dim Val1 As String, Val2 As String Dim Index1 As Long, Index2 As Long Val1 = getSelectedItem(ListBox1) Index1 = getSelectedIndex(ListBox1) Val2 = getSelectedItem(ListBox2) Index2 = getSelectedIndex(ListBox2) ListBox1.List(Index1) = Val2 ListBox2.List(Index2) = Val1 End Sub Function getSelectedItem(lbo As msforms.ListBox) As String Dim Counter As Long Do While Counter <= lbo.ListCount And getSelectedItem = "" If lbo.Selected(Counter) Then getSelectedItem = lbo.List(Counter) Counter = Counter + 1 Loop End Function Function getSelectedIndex(lbo As msforms.ListBox) As Long Dim Counter As Long getSelectedIndex = -1 Do While Counter <= lbo.ListCount And getSelectedIndex = -1 If lbo.Selected(Counter) Then getSelectedIndex = Counter Counter = Counter + 1 Loop End Function
Situations avant et après clic sur le bouton

Pièce jointe 560288

Pièce jointe 560290

Si tu veux sélectionner plusieurs valeurs dans chaque liste et les permuter, il sera préférable de passer par des tableaux (array) mais aussi de préciser ta demande (même nombre d'items de chaque côté? Même place dans la listbox d'arrivée? Listbox triées? ...)

27/04/2020, 00h23
eschilte

Merci

Bonsoir et merci Pierre Fauconnier pour ta réactivité. Je n'ai pas encore essayer ton code et je te tiendrai informé du résultat.
Je ne vais pas cliquer sur résolu tout de suite car j'aimerais comprendre ce qui ne fonctionne pas dans mon code , si quelqu'un peut s'y pencher.
Merci également à transitoire pour l'explication sur l'indentation
Bonne soirée à tous

1 pièce(s) jointe(s)

Bonjour …

Avec «J'ai un formulaire avec 8 listbox (fmMultiselectsingle). Si je selectionne 1 item sur 2 des listbox …» et en titre «Echange entre deux listbox » …

Exemple avec 4 listes (ou 2, 3 …) en jeu : Usf avec alimentation des listes par 4 tableaux nommés ç1, ç2, ç3, ç4 et un Module de classe nommé Lst
Dans le module du formulaire

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
Dim n As Byte, Lst(4) As New Lst                                        'pour le module de classe nommé Lst
Private Sub UserForm_Initialize()
  L1.List = [ç1].Value:  L2.List = [ç2].Value
  L3.List = [ç3].Value : L4.List = [ç4].Value                                  'à contrôler (pas demandé !)
  For n = 1 To 4: Set Lst(n).Lst = Me("L" & n):  Next                     'pour le Module de classe  avec 4 listes
End Sub
Private Sub Change_Click()
  Dim a, k As Byte, O1 As Control, O2 As Control, i1 As Long, i2 As Long
  Dim t(4, 3)
  For n = 1 To 4
    If Me("L" & n).Tag <> "" Then
      a = Split(Me("L" & n).Tag, ";")
      k = k + 1
      t(k, 1) = "L" & n: t(k, 2) = a(0): t(k, 3) = a(1)                   'nom de listes, index des sélections, item des listes
      Me("L" & n).Tag = ""
  End If
  Next
  If t(1, 2) <> "" And t(2, 2) <> "" Then
    Set O1 = Me.Controls(t(1, 1)):  Set O2 = Me.Controls(t(2, 1))
    O1.List(t(1, 2)) = t(2, 3):  O2.List(t(2, 2)) = t(1, 3)                'permutation des items
    O1 = "": O2 = "": O1.Tag = "": O2.Tag = ""                              'plus de sélections
  End If
End Sub

Et dans le Module de classe

Code:

1
2
3
4
Public WithEvents Lst As Msforms.ListBox
Private Sub Lst_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Lst.Tag = Lst.ListIndex & ";" & Lst.Value                                      'nom, index et item de la liste
End Sub

Remarques :
- je ne me suis pas préoccupé de l'initialisation des Listes car ce n'était pas demandé ici !
- je ne me suis pas préoccupé d'autres développements du formulaire car ce n'était pas demandé ici !
- Avec seulement 2 listes( L1 et L2) bien précises, sans module de classe on peut se contenter de

Code:

1
2
3
4
5
6
7
8
9
Private Sub Change_Click()
  Dim i1 As Single, i2 As Single, n1 As String, n2 As String
  i1 = L1.ListIndex
  If i1 < 0 Then Exit Sub Else n1 = L1
  i2 = L2.ListIndex
  If i2 < 0 Then Exit Sub Else n2 = L2
  L1.List(i1) = n2:  L2.List(i2) = n1
  L1 = "": L2 = ""
End Sub

Ordonc,

Qu'il y ait 2, 4, 8 ou 100 listobox, la permutation se fait toujours entre 2 listbox. Je ne vois pas bien comment tu pourrais en permuter plus en même temps.

Attention que ton code sur le change_Click peut fonctionner, mais qu'il ne permet pas l'erreur de saisie, car dès que tu vas cliquer sur un item du second listbox, il va le permuter avec celui du premier, sans possibilité de revenir en arrière si erreur, et sans que l'utilisateur soit averti ou ait décidé que c'est ainsi que ça doit se passer. Sur le plan ergonomique, c'est bof bof...

Pour pouvoir permuter deux autres listbox, il suffit de paramétrer les listbox manipulées par la procédure PermuteValues, et il n'est pas nécessaire de passer par un module de classe pour cela.
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub PermuteValues(lbo1 As MSForms.ListBox, lbo2 As MSForms.ListBox) Dim Val1 As String, Val2 As String Dim Index1 As Long, Index2 As Long Val1 = getSelectedItem(lbo1) Index1 = getSelectedIndex(lbo1) Val2 = getSelectedItem(lbo2) Index2 = getSelectedIndex(lbo2) lbo1.List(Index1) = Val2 lbo2.List(Index2) = Val1 End Sub
Encore faudra-t-il savoir quelles listbox permuter sur les 8, et sur base de quelle action de l'utilisateur... Je n'imagine pas que le choix des listbox à permuter se fasse uniquement sur le fait de cliquer sur des items des listbox, personnellement, et il faudrait en connaître plus sur l'ergonomie souhaitée par le demandeur avant de déterminer que c'est telle ou telle action qui enclenche le process. Au demeurant, le fait de découpler le code exécutif du code événementiel permet justement d'ajuster au mieux l'exécution du code à l'ergonomie souhaitée.

Les codes proposés sont donc génériques et illustrent la mise en place à réaliser, le choix des listbox à permuter restant à déterminer par le demandeur, si tant est que cela pose problème pour lui

Bonjour,
J'ai essayé d'inclure le code de Pierre Fauconnier tôt ce matin mais j'ai oublié de préciser que mes listbox ont 5 colonnes.

Voici comment j'ai essayé de gérer cela

Ajout d'une boucle avec variable externe i correspondant au nombre de colonnes:
Code:

1 2 3 4 5 6 7 8 9 for i = 0 to 4 Val1 = getSelectedItem(lbo1) Index1 = getSelectedIndex(lbo1) Val2 = getSelectedItem(lbo2) Index2 = getSelectedIndex(lbo2) lbo1.List(Index1,i) = Val2 lbo2.List(Index2,i) = Val1 next I
Ajout de i dans la fonction:
Code:

1 2 3 4 5 6 7 8 Function getSelectedItem(lbo As msforms.ListBox) As String Dim Counter As Long Do While Counter <= lbo.ListCount And getSelectedItem = "" If lbo.Selected(Counter) Then getSelectedItem = lbo.List(Counter,i) Counter = Counter + 1 Loop End Function
La aussi, j'ai des erreurs.
Mon problème initiale de non changement de la deuxième valeur cliquée mais maintenant seulement sur la première colonne. On progresse !
Mais avec en plus une erreur de dépassement de pile et bizarrement une boucle qui ne s’arrête pas à 4. Oups !
Je creuserai ce soir

Pour répondre un peu plus précisément sur le fonctionnement que j'avais réalisé:
Les listbox sont remplies via les cellules d'une feuille de calcul. On peut revenir en arrière grâce à cette feuille.
Le choix de permutation n'est donné que si 2 des 8 listbox ont une sélection
L'utilisateur peut désélectionner en double cliquant sur l'item

Bonne journée à tous

27/04/2020, 20h45
eschilte

Merci

Ordonc, merci pour ton aide
Bonne soirée

Résolu, merci à tous

Bonjour,
Pour ceux qui seraient intéressé, voici le code qui fonctionne, du moins, qui me contente.
Mon problème venait en fait d'une variable i que j'utilisais en interne et en externe.
J'ai gardé une grande partie du code de Pierre beaucoup plus pro que le mien.
Merci à tous

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
 
Option Explicit
Dim NbListItemSelect As Integer, i As Integer, col As Integer
Dim PremiereListboxNum As String, SecondeListboxNum As String
 
Private Sub CompterNbListItemSelect() 'Récupère le nom des listbox ayant un item selectionné
 Dim Ctl As Control
 NbListItemSelect = 0
 PremiereListboxNum = ""
 SecondeListboxNum = ""
With UserForm7
    For Each Ctl In .Controls
        If TypeName(Ctl) = "ListBox" Then
            For i = 0 To Ctl.ListCount - 1
                If Ctl.Selected(i) Then NbListItemSelect = NbListItemSelect + 1
                    Select Case NbListItemSelect
                    Case Is = 1
                    If PremiereListboxNum = "" Then
                    PremiereListboxNum = Right(Ctl.Name, 1)
                    End If
                    Case Is = 2
                     If SecondeListboxNum = "" Then
                    SecondeListboxNum = Right(Ctl.Name, 1)
                    End If
                    End Select
            Next i
        End If
    Next Ctl
End With
If NbListItemSelect = 2 Then
UserForm7.CommandButton7.Enabled = True 'Bouton permutation
End If
End Sub
 
Sub PermuteValues()
Dim Val1 As String, Val2 As String
Dim Index1 As Long, Index2 As Long
For col = 0 To 4     'Boucle sur les colonnes des listbox
    Val1 = getSelectedItem(UserForm7.Controls("ListBox" & PremiereListboxNum))
    Index1 = getSelectedIndex(UserForm7.Controls("ListBox" & PremiereListboxNum))
    Val2 = getSelectedItem(UserForm7.Controls("ListBox" & SecondeListboxNum))
    Index2 = getSelectedIndex(UserForm7.Controls("ListBox" & SecondeListboxNum))
    UserForm7.Controls("ListBox" & PremiereListboxNum).List(Index1, col) = Val2
    UserForm7.Controls("ListBox" & SecondeListboxNum).List(Index2, col) = Val1
Next col
End Sub
 
Function getSelectedItem(lbo As MSForms.ListBox) As String
  Dim Counter As Long
  Do While Counter <= lbo.ListCount And getSelectedItem = ""
    If lbo.Selected(Counter) Then getSelectedItem = lbo.List(Counter, col)
    Counter = Counter + 1
  Loop
End Function
 
Function getSelectedIndex(lbo As MSForms.ListBox) As Long
  Dim Counter As Long
  getSelectedIndex = -1
  Do While Counter <= lbo.ListCount And getSelectedIndex = -1
    If lbo.Selected(Counter) Then getSelectedIndex = Counter
    Counter = Counter + 1
  Loop
End Function