Aide sur LISBOX + Bouton Transfert

[cumpa]

Bonjours

J’essaie de créer un LISTBOX avec un bouton *Transfert*, pour inséré les mots que sont dans l’onglet *BD* dans la colonne *SYMPA* de l’onglet *TBL* du classeur.

Je crée un listebox + un bouton Transfert dans le classeur attache, mon problème ce faire fonctionner cette liste depuis l’onglet TBL. Merci de votre Aide

Bonne journée

PS: Dans l'onglet *listbox* je crée une listbox avec l'option pour sélectionner le mots.

 

[youky(BJ)]

Re : Aide sur LISBOX + Bouton Transfert

Bonjour cumpa,
Ce code à mettre dans un module
Bruno

Sub CopyList()
Dim k
lig = Sheets("TBL").[G65000].End(3).Row + 1
With Sheets("ListBox").ListBox1
For k = 0 To .ListCount - 1
If .Selected(k) = True Then
Sheets("TBL").Cells(lig, 7) = .List(k)
lig = lig + 1
End If
Next
End With
End Sub

 

[cumpa]

Re : Aide sur LISBOX + Bouton Transfert

Bonjour

Je collez le code sur une module, en suite je doit faire quoi ? crée un bouton pour allez chercher la listbox avec le mots ????

Désole me BVA ce ne pas mas tasse de thé....

Merci

Bonjour cumpa,
Ce code à mettre dans un module
Bruno

Sub CopyList()
Dim k
lig = Sheets("TBL").[G65000].End(3).Row + 1
With Sheets("ListBox").ListBox1
For k = 0 To .ListCount - 1
If .Selected(k) = True Then
Sheets("TBL").Cells(lig, 7) = .List(k)
lig = lig + 1
End If
Next
End With
End Sub

 

[youky(BJ)]

Re : Aide sur LISBOX + Bouton Transfert

Re,
Bon voici ton fichier, désolé ce matin je n'avais pas vu le bouton "transfert"
Bruno

 

[cumpa]

Re : Aide sur LISBOX + Bouton Transfert

Merci Bruno.

Dernier question Bruno, ont peut faire que le mots sélectionne dans la Liste Box, puisse être inséré tous dans la même cellule ??????????.

C'est une travaille répétitive donc aujourd’hui ont copie chaque mots à la main car dans chaque cellule le nombre mots changent. Si ont peut le simplifier le travail serai super cool.


Bonne soirée

Merci encore

 

[youky(BJ)]

Re : Aide sur LISBOX + Bouton Transfert

Voici 2 solutions....
la 1ere les mots sont écrit les uns en dessous des autres dans la même cellule
la 2eme les mots sont écrit à la suite séparé d'un espace

Private Sub CmdTransfert_Click()
lig = Sheets("TBL").[G65000].End(3).Row + 1
With Sheets("ListBox").ListBox1
For k = 0 To .ListCount - 1
If .Selected(k) = True Then
tx = tx & Chr(10) & .List(k)
.Selected(k) = False
End If
Next
tx = Right(tx, Len(tx) - 1)
Sheets("TBL").Cells(lig, 7) = tx
End With
End Sub

solution 2

Private Sub CmdTransfert_Click()
lig = Sheets("TBL").[G65000].End(3).Row + 1
With Sheets("ListBox").ListBox1
For k = 0 To .ListCount - 1
If .Selected(k) = True Then
tx = tx & " " & .List(k)
.Selected(k) = False
End If
Next
tx = Right(tx, Len(tx) - 1)
Sheets("TBL").Cells(lig, 7) = tx
End With
End Sub

Dans le 1er cas entre les noms est inséré un retour à la ligne et l'autre 1 espace
Double click sur le bouton en mode création pour tomber sur le code.
Bruno