XL 2019 Problème de clic dans ListBox

Audrey_T_1975 · 5 Octobre 2023

Bonjour,
J'ai créé un UserForm avec deux listbox. La première récupère les noms des feuilles de mon classeur et la deuxième me permet de transférer les noms des feuilles que je veux imprimer.
Lorsque je transferts de la LixtBox1 vers la ListBox2, les noms se retirent de la ListBox1, s'ajoutent et se classent par ordre alphanumérique dans la ListBox2.
Jusque là tout marche.
Mon problème est que lorsque je clique de nouveau sur la LitBox1 tous les noms de mes feuilles apparaissent de nouveau.
Comment est ce que je peux faire pour éviter de répéter l'ajout des noms des feuilles dans ma ListBox1 si je clique plusieurs fois dessus pour ajouter d'autres feuilles dans ListBox2?
D'avance merci.

Dudu2 · 5 Octobre 2023

Essaie avec ça en remplacement complet du code présent dans le UserForm.

VB:

Option Explicit

'-----------------
'UserForm Activate
'-----------------
Private Sub UserForm_Activate()
    Dim i As Integer
 
    'Chargement ListBox1
    With ActiveWorkbook
        For i = 6 To .Sheets.Count
            If .Sheets(i).Visible = True Then Me.ListBox1.AddItem .Sheets(i).Name
        Next i
    End With
    Call TriListBox(Me.ListBox1)
 
    'MultiSelect ListBox1 & ListBox2
    Me.ListBox1.MultiSelect = fmMultiSelectExtended
    Me.ListBox2.MultiSelect = fmMultiSelectExtended
End Sub

'-------------------------------
'Quitter le UseForm ufExportPPAP
'-------------------------------
Sub cbQuitter_Click()
    Unload Me
End Sub...

Dudu2 · 5 Octobre 2023

Bonjour,
Sans le fichier et son code impossible de répondre.
Même les experts n'ont pas le don de divination.

Audrey_T_1975 · 5 Octobre 2023

Pas faux
Le voici :
Sub ListBox1_Enter()

Dim i, j As Integer
Dim wb As Integer
Dim temp

With Me.ListBox1
wb = ActiveWorkbook.Sheets.Count
For i = 6 To wb
If Sheets(i).Visible = True Then .AddItem Sheets(i).Name
Next i
End With
ListBox1.MultiSelect = fmMultiSelectExtended

For i = 0 To ListBox1.ListCount - 1
For j = 0 To ListBox1.ListCount - 1
If ListBox1.List(i) < ListBox1.List(j) Then
temp = ListBox1.List(i)
ListBox1.List(i) = ListBox1.List(j)
ListBox1.List(j) = temp
End If
Next j
Next i
End Sub

Dudu2 · 5 Octobre 2023

VB:

Sub ListBox1_Enter()
    Dim i, j As Integer
    Dim wb As Integer
    Dim temp
    
    With Me.ListBox1
        wb = ActiveWorkbook.Sheets.Count
        For i = 6 To wb
            If Sheets(i).Visible = True Then .AddItem Sheets(i).Name
        Next i
    End With
    
    ListBox1.MultiSelect = fmMultiSelectExtended
    
    For i = 0 To ListBox1.ListCount - 1
        For j = 0 To ListBox1.ListCount - 1
            If ListBox1.List(i) < ListBox1.List(j) Then
                temp = ListBox1.List(i)
                ListBox1.List(i) = ListBox1.List(j)
                ListBox1.List(j) = temp
            End If
        Next j
    Next i
End Sub

Ça c'est lorsqu'on entre dans ListBox1, le chargement de toutes les feuilles visibles à partir de la 6ème et le tri sur leur nom.

On ne peut rien conclure avec cette seule fonction.
Qu'est-ce que vous voulez faire ? Retirer de ListBox1 les items de ListBox2 ?

Dudu2 · 5 Octobre 2023

Envoyez le code du UserForm, au moins pour TOUT ce qui concerne ListBox1 et ListBox2.
Utilisez le symbole </> pour y placer le code s'il est correctement indenté chez vous.

Audrey_T_1975 · 5 Octobre 2023

Oui je veux les retirer de la ListBox1 et les ajouter dans la ListBox2. et si je veux les retirer de la ListBox2 et les remettre dans la ListBox1 je veux qu'ils se retirent de la ListBox2 et se classe par ordre alphanumérique dans la ListBox1.

Dudu2 · 5 Octobre 2023

Ok, j'ai capté le code.
Si ce fichier est un fichier d'entreprise, je vous conseille de modifier votre post et de le supprimer.
Il suffit de cliquer sur le symbole poubelle associé au fichier.
Je regarde et vous renvoie le code dans la soirée.

Audrey_T_1975 · 5 Octobre 2023

Ok merci. J'ai suivi votre conseil.
Merci pour votre support.

Dudu2 · 5 Octobre 2023

Essaie avec ça en remplacement complet du code présent dans le UserForm.

VB:

Option Explicit

'-----------------
'UserForm Activate
'-----------------
Private Sub UserForm_Activate()
    Dim i As Integer
 
    'Chargement ListBox1
    With ActiveWorkbook
        For i = 6 To .Sheets.Count
            If .Sheets(i).Visible = True Then Me.ListBox1.AddItem .Sheets(i).Name
        Next i
    End With
    Call TriListBox(Me.ListBox1)
 
    'MultiSelect ListBox1 & ListBox2
    Me.ListBox1.MultiSelect = fmMultiSelectExtended
    Me.ListBox2.MultiSelect = fmMultiSelectExtended
End Sub

'-------------------------------
'Quitter le UseForm ufExportPPAP
'-------------------------------
Sub cbQuitter_Click()
    Unload Me
End Sub

'------------------------------------------------------
'Transferer les Items PPAP de la ListBox1 vers ListBox2
'------------------------------------------------------
Sub cbTransferer_Click()
    Call TransférerItems(Me.ListBox1, Me.ListBox2)
    Me.TextBox1 = Me.ListBox2.ListCount
End Sub

'------------------------------------------------------
'Transferer les Items PPAP de la ListBox2 vers ListBox1
'------------------------------------------------------
Sub cbRetirer_Click()
    Call TransférerItems(Me.ListBox2, Me.ListBox1)
    Me.TextBox1 = Me.ListBox2.ListCount
End Sub

'----------------------------------------------------
'Imprimer en format pdf les items PPAP de la ListBox2
'----------------------------------------------------
Sub cbImprimer_Click()
    Dim i As Integer
    Dim k As Integer
    Dim TOS() As Variant
 
    For i = 0 To Me.ListBox2.ListCount - 1
        ListBox2.Selected(i) = True
    Next i
 
    With Me.ListBox2
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                ReDim Preserve TOS(k)
                TOS(k) = .List(i)
                k = k + 1
            End If
        Next i
    End With
 
    If k = 0 Then
        MsgBox "Veuillez choisir au moins un onglet"
    Else
       Sheets(TOS).Select
    End If
 
    Call Module1.Export_PDF
End Sub

'--------------------------------------------------------------------------------
'Transférer les items sélectionnés de la ListBoxSource vers la ListBoxDestination
'--------------------------------------------------------------------------------
Sub TransférerItems(ListBoxSource As MSForms.ListBox, ListBoxDestination As MSForms.ListBox)
    Dim i As Integer
   
    If ListBoxSource.ListCount = 0 Then Exit Sub
   
    'Ajoute les items sélectionnés de ListBoxSource dans ListBoxDestination
    For i = 0 To ListBoxSource.ListCount - 1
        If ListBoxSource.Selected(i) Then
            ListBoxDestination.AddItem ListBoxSource.List(i)
        End If
    Next i
   
    'Retire les items sélectionnés de ListBoxSource
    For i = ListBoxSource.ListCount - 1 To 0 Step -1
        If ListBoxSource.Selected(i) Then
            ListBoxSource.RemoveItem (i)
        End If
    Next i
   
    Call TriListBox(ListBoxSource)
    Call TriListBox(ListBoxDestination)
End Sub

'---------------------------
'Tri des items d'une ListBox
'---------------------------
Sub TriListBox(ListBox As MSForms.ListBox)
    Dim i As Integer 
    Dim TabListBoxItems() As Variant
 
    If ListBox.ListCount = 0 Then Exit Sub
 
    'TabListBoxItems = ListBox.List NON car génère un tableau à 2 dimensions !?
    ReDim TabListBoxItems(0 To ListBox.ListCount - 1)
    For i = 0 To ListBox.ListCount - 1
        TabListBoxItems(i) = ListBox.List(i)
    Next i
    'MsgBox "Nb items = " & UBound(TabListBoxItems) - LBound(TabListBoxItems) + 1
 
    Call TriT1D(TabListBoxItems, LBound(TabListBoxItems), UBound(TabListBoxItems))
    ListBox.List = TabListBoxItems
End Sub

'-------------------------------------------------------
'Tri QuickSort Boisgontier
'http://boisgontierj.free.fr/pages_site/tableaux.htm#Tri
'Exemple: Call TriT1D(t, LBound(t), UBound(t))
'-------------------------------------------------------
Sub TriT1D(a, gauc, droi, Optional sens = 1) ' Quick sort
    Dim ref, g, d, temp
    ref = a((gauc + droi) \ 2)
    g = gauc: d = droi
    Do
        If sens > 0 Then
            Do While a(g) < ref: g = g + 1: Loop
            Do While ref < a(d): d = d - 1: Loop
        Else
            Do While a(g) > ref: g = g + 1: Loop
            Do While ref > a(d): d = d - 1: Loop
        End If
        If g <= d Then
            temp = a(g): a(g) = a(d): a(d) = temp
            g = g + 1: d = d - 1
        End If
    Loop While g <= d
    If g < droi Then Call TriT1D(a, g, droi, sens)
    If gauc < d Then Call TriT1D(a, gauc, d, sens)
End Sub

Audrey_T_1975 · 5 Octobre 2023

Merci beaucoup. Ça marche. Une partie de mon code a été gardé.
Pourquoi ça ne marchait pas avec mon code?

Dudu2 · 5 Octobre 2023

Ça ne marchait pas parce que la ListBox1 était ré-initialisée:
- Sur l'évènement UserForm_Click() (je n'utilise jamais cet évènement ni personne à ma connaissance)
- Sur l'évènement ListBox1_Enter()
Donc à chaque fois qu'on cliquait dans ListBox1 elle était ré-initialisée.

Pour faire des choses (ex. charger la ListBox1) à l'initialisation d'un UserForm il faut le faire dans l'évènement UserForm_Activate() ou dans certains cas particuliers dans UserForm_Initialize() que perso j'évite d'utiliser.

Audrey_T_1975 · 5 Octobre 2023

OK Merci beaucoup pour le support et les explications.
Je vous souhaite une bonne soirée.

Dudu2 · 5 Octobre 2023

Merci, de même.

XL 2019 Problème de clic dans ListBox

Audrey_T_1975

XLDnaute Nouveau

Dudu2

Dudu2

XLDnaute Barbatruc

Audrey_T_1975

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Audrey_T_1975

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

Audrey_T_1975

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

Audrey_T_1975

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

Audrey_T_1975

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

Discussions similaires