UserForm ListBox MultiSelect avec une tableau structuré

[taratata]

Bonjour,

Après avoir écumé plusieurs forums, je suis toujours en panne sur se problème.
On trouve beaucoup de solution avec une liaison type Range (plage nommée), qui fonctionne bien.


J'ai un tableau structuré lié à une ListBox type UserForm en mode MultiSelect fmMultiSelectMulti.

le but est de sélectionner plusieurs ligne de cette listbox pour les écrire dans une feuille excel.

j'ai posé ce code sur un bouton

Private Sub CommandButton3_Click()
Dim addme As Range
Dim cNum As Integer
Dim x As Integer
Dim y As Integer
Dim bSelected As Boolean

' Rows.count,1 - sur la feuille , Ecrit à partir de la 1er colonne
' Offset(1,0) - Permet un décalage vers le bas pour la prochaine écriture
Set addme = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

bSelected = False
cNum = 7    ' Nombre de colonne de la source (plage nommée - Tableau nommé)

'Me.ListBox1.MultiSelect = fmMultiSelectMulti

For x = 0 To (Me.ListBox1.ListCount - 1)
' MsgBox "Numéro de la ligne  source  " & x
    
    If Me.ListBox1.Selected(x) = True Then
        bSelected = True
        Debug.Print Me.ListBox1.List(x)
        
        For y = 0 To cNum
            addme.Offset(0, y) = Me.ListBox1.List(x, y)
        Next y
        
        Set addme = addme.Offset(1, 0)

    End If
    
    ' supprime les valeurs
    Me.ListBox1.Selected(x) = False
Next x

If bSelected = False Then
    MsgBox "rien de sélectionné"
End If
End Sub

Il y a uniquement 1 ligne qui est transcrites dans le feuille excel
merci pour votre temps...

 

[youky(BJ)]

Bonjour,
Un fichier exemple aurai été mieux
J'ai fait la macro avec le Bloc-Note, donc rien de testé
Bruno

lig=sheets("Feuil1").end(3).row+1'ligne d'écriture
For k = 0 To ListBox1.ListCount - 1
If Listbox1.Seleced(k) then
for col=1 to 7
Sheets("Feuil1").cells(lig,col)=Listbox1.List(k,col-1)
Next
Listbox1.selected(k)=false
lig=lig+1
Next

 

[taratata]

en faite, dans le SUB CommandButton3_Click
dans la boucle --> For y = 0 To cNum

lorsqu'il y seulement une msgbox, j'ai bien les valeurs des lignes sélectionnée.
Donc le multiselect fonctionne.

le problème ce trouve au niveau de l'ajout de commande pour écrire sur la feuille
L’écriture s'effectue mais une seul ligne

j'ai aussi vérifié avec debug.print

voici le fichier demandé

merci

 

[youky(BJ)]

Hello,
Ca doit le faire
Bruno

Private Sub CommandButton3_Click()
Dim cNum%
Dim x%
Dim col%
Dim bSelected As Boolean

With Sheets("Feuil1")
.Select
'ligne ou écrire
lig = .Cells(Rows.Count, 1).End(xlUp).Row + 1
' Nombre de colonne
cNum = 7
ListBox1.MultiSelect = fmMultiSelectMulti
For x = 0 To ListBox1.ListCount - 1
        If Creation_Liquide.ListBox1.Selected(x) = True Then
            bSelected = True
                For col = 0 To cNum
                 .Cells(lig, col + 1) = ListBox1.List(x, col)
                Next col
             lig=lig+1
        End If
        ' Déselectionne les lignes
        ListBox1.Selected(x) = False
Next x
End With
If bSelected = False Then MsgBox "rien de sélectionné"
End Sub

 

[taratata]

toujours une seul ligne inscrite dans la feuille

 

[youky(BJ)]

J'ai ajouté lig=lig+1 il y a qlq secondes

 

[taratata]

toujours la même chose... une seul ligne inscrite...

 

[youky(BJ)]

Re,
supprime RowSource de listbox1
en initialize
Private Sub UserForm_Initialize()
tablo = [Tab_BNIC]
ListBox1.List = tablo
End Sub

 

[taratata]

c'est parfais cette pirouette.
bizarre qu'il aie fallu supprimer RowSource sur le control

merci infiniment

 

[taratata]

un grand merci à youky pour son temps
voici le code -

Option Base 1

Private Sub CommandButton3_Click()
Dim cNum%       ' Nb col Tableau à écrire sur la Feuil1
Dim x%
Dim col%
Dim bSelected As Boolean

    With Sheets("Feuil1")
        .Select
        ' Ligne
        lig = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        
        cNum = 7
        'Me.ListBox1.MultiSelect = fmMultiSelectMulti
            For x = 0 To Me.ListBox1.ListCount - 1
                    If Me.ListBox1.Selected(x) = True Then
                        bSelected = True
                            For col = 0 To cNum
                                .Cells(lig, col + 1) = Me.ListBox1.List(x, col)
                            Next col
                        lig = lig + 1
                    End If

                ' Déselectionne les lignes
                Me.ListBox1.Selected(x) = False
            Next x
    End With

If bSelected = False Then MsgBox "rien de sélectionné"
End Sub

Private Sub UserForm_Initialize()

' --------  Le contrôle ListBox doit être configurer  -------

' - MultiSelect = fmMultiSelectMulti
' - ColumnCount
' - Columnwidths

' -------  RowSource doit être configurer ci-dessous  -------

    ' Déclaration du tableau structuté
    tablo = [Tab_BNIC]
    ' Lien RowSource
    ListBox1.List = tablo
    
End Sub