Enregistrer listbox multiselection dans une seule cellule

tomover · 30 Septembre 2014

Bonjour,

J'aimerai enregistrer le contenu d'une liste qui est situé dans un Userform, dans une même cellule.
Je n'arrive pas à enregistrer les lignes sélectionnée dans un même cellule avec un retour chario.

J'ai vu beaucoup de sujet mais je n'ai pas vraiment réussi à adapter en fonction de mon besoin

Comment pourrais-je procéder ?

Robert · 30 Septembre 2014

Re : Enregistrer listbox multiselection dans une seule cellule

Bonjour Tomover, bonjour le forum,

Peut-être comme ça :

Code:

Private Sub CommandButton1_Click()
Dim I As Integer
Dim T As String

' vérification de la saisie champ1
If Me.TextBox1.Text = "" Then
    MsgBox "Vous saisir le champ 1"
    Me.TextBox1.SetFocus
    Exit Sub
End If

' Enregistrement du champ 1
Sheets("bdd data").Range("A65536").End(xlUp).Offset(1, 0).Value = TextBox1

For I = 0 To Me.Comsprint1.ListCount - 1
    If Me.Comsprint1.Selected(I) = True Then T = IIf(T = "", Me.Comsprint1.List(I), T & Chr(10) & Me.Comsprint1.List(I))
Next I
Sheets("bdd data").Range("B65536").End(xlUp).Offset(1, 0).Value = T
End Sub

tomover · 30 Septembre 2014

Re : Enregistrer listbox multiselection dans une seule cellule

Génial ça marche ! Merci pour de t'être penché sur mon problème et pour ta réactivité.

Que signifie le T et le I ?

Si je désire ajouter un - avant chaque ligne je fais comment ?

Robert · 30 Septembre 2014

Re : Enregistrer listbox multiselection dans une seule cellule

Bonsoir Tomover, bonsoir le forum,

Le T et le I ne signifient rien de spécial. Ils correspondent à des variables que j'ai définies. On pourrait leur donner le nom que tu veux... La variable T (Texte) va permettre de stocker les éléments cochées de la ListBox Comsprint1. La variable I (Incrément) va permettre de boucler.

Pour ajouter un tiret devant, remplace la ligne :

Code:

If Me.Comsprint1.Selected(I) = True Then T = IIf(T = "", Me.Comsprint1.List(I), T & Chr(10) & Me.Comsprint1.List(I))

par :

Code:

If Me.Comsprint1.Selected(I) = True Then T = IIf(T = "", "- " & Me.Comsprint1.List(I), T & Chr(10) & "- " & Me.Comsprint1.List(I))

On boucle sur tous les éléments de la Listbox Comsprint1. Si l'élément est sélectionné alors T vaut :
• un tiré, un espace, l'élément sélectionné / si T est vide (donc la première fois)
• T, un retour de chariot, un tiret, un espace et l'élément sélectionné / si T n'est pas vide (donc à partir du second élément)

tomover · 1 Octobre 2014

Re : Enregistrer listbox multiselection dans une seule cellule

Merci Robert pour tes explications. c'est TOP !

Par contre je me rend compte d'un petit problème.

Le choix d'un critère dans le liste n'est pas obligatoire.
Donc l'ors d'un prochain enregistrement je vais avoir un décalage d'une ligne puisse que je cherche la dernier ligne vide !

Code:

Sheets("bdd data").Range("B65536").End(xlUp).Offset(1, 0).Value = T

Il n'y aurait pas une autre façon d’enregistrer les données dans une même ligne ? (une ligne par enregistrement sans chercher à chaque fois la dernière cellule vide)

Robert · 1 Octobre 2014

Re : Enregistrer listbox multiselection dans une seule cellule

Bonjour Tomover, bonjour le forum,

Essaie comme ça :

Code:

Private Sub CommandButton1_Click()
Dim I As Integer 'déclare la variable I (Incrément)
Dim T As String 'déclare la variable T (Texte)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

' vérification de la saisie champ1
If Me.TextBox1.Text = "" Then
    MsgBox "Vous saisir le champ 1"
    Me.TextBox1.SetFocus
    Exit Sub
End If
Set DEST = Sheets("bdd data").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
DEST.Value = TextBox1 ' Enregistrement du champ 1
For I = 0 To Me.Comsprint1.ListCount - 1 'boucle sur tous les éléments de la listbox "Comsprint1"
    'définit le texte T
    If Me.Comsprint1.Selected(I) = True Then T = IIf(T = "", "- " & Me.Comsprint1.List(I), T & Chr(10) & "- " & Me.Comsprint1.List(I))
Next I 'prochain élément de la boucle
DEST.Offset(0, 1).Value = T ' Enregistrement tu texte T
End Sub

tomover · 1 Octobre 2014

Re : Enregistrer listbox multiselection dans une seule cellule

ça fonctionne bien... mais j'ai du mal à comprendre où est défini la colonne où sera enregistré la listbox Comsprint1

Une boucle incrémente la position de la colonne de +1 ?

car je vais avoir beaucoup de champs à ajouter au formulaire...

J'essai d'ajouter une seconde liste là....

tomover · 1 Octobre 2014

Re : Enregistrer listbox multiselection dans une seule cellule

Enajoutant une seconde liste les données se retrouve dans la même cellule !
Il doit y avoir un truc qui m'échappe pour définir la bonne colonne

Code:

Private Sub CommandButton1_Click()
Dim I As Integer 'déclare la variable I (Incrément)
Dim T As String 'déclare la variable T (Texte)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

' vérification de la saisie champ1
If Me.TextBox1.Text = "" Then
    MsgBox "Vous saisir le champ 1"
    Me.TextBox1.SetFocus
    Exit Sub
End If

'ENREGISTREMENT CHAMP 1-------------------------
Set DEST = Sheets("bdd data").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
DEST.Value = TextBox1 ' Enregistrement du champ 1


'ENREGISTREMENT LIST A--------------------------
For I = 0 To Me.Comsprint1.ListCount - 1 'boucle sur tous les éléments de la listbox "Comsprint1"
    'définit le texte T
    If Me.Comsprint1.Selected(I) = True Then T = IIf(T = "", "- " & Me.Comsprint1.List(I), T & Chr(10) & "- " & Me.Comsprint1.List(I))
Next I 'prochain élément de la boucle
DEST.Offset(0, 1).Value = T ' Enregistrement tu texte T


'ENREGISTREMENT LIST B--------------------------
For I = 0 To Me.Comsprint2.ListCount - 1 'boucle sur tous les éléments de la listbox "Comsprint1"
    'définit le texte T
    If Me.Comsprint2.Selected(I) = True Then T = IIf(T = "", "- " & Me.Comsprint2.List(I), T & Chr(10) & "- " & Me.Comsprint2.List(I))
Next I 'prochain élément de la boucle
DEST.Offset(0, 1).Value = T ' Enregistrement tu texte T


End Sub

Robert · 1 Octobre 2014

Re : Enregistrer listbox multiselection dans une seule cellule

Bonjour Tomover, bonjour le forum,

Je pensais que le code initial venais de toi mais visiblement ce n'est pas le cas...
Comme la donnée dans la colonne A est obligatoire et donc toujours renseignée, c'est elle qui détermine la ligne avec :

Code:

Set DEST = Sheets("bdd data").Range("A65536").End(xlUp).Offset(1, 0)

Dest.Offset(0, 1)correspond à cette cellule décalée d'une colonne à droite. C'est là que l'on place le texte T.

Pour la seconde listbox utilise DEST.Offset(0, 2)... Et aussi une seconde variable T ou alors il faut la réinitialiser !

Code:

Private Sub CommandButton1_Click()
Dim I As Integer 'déclare la variable I (Incrément)
Dim T As String 'déclare la variable T (Texte)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

' vérification de la saisie champ1
If Me.TextBox1.Text = "" Then
    MsgBox "Vous saisir le champ 1"
    Me.TextBox1.SetFocus
    Exit Sub
End If

'ENREGISTREMENT CHAMP 1-------------------------
Set DEST = Sheets("bdd data").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
DEST.Value = TextBox1 ' Enregistrement du champ 1


'ENREGISTREMENT LIST A--------------------------
For I = 0 To Me.Comsprint1.ListCount - 1 'boucle sur tous les éléments de la listbox "Comsprint1"
    'définit le texte T
    If Me.Comsprint1.Selected(I) = True Then T = IIf(T = "", "- " & Me.Comsprint1.List(I), T & Chr(10) & "- " & Me.Comsprint1.List(I))
Next I 'prochain élément de la boucle
DEST.Offset(0, 1).Value = T ' Enregistrement tu texte T

T = "" 'réinitialise la variable T

'ENREGISTREMENT LIST B--------------------------
For I = 0 To Me.Comsprint2.ListCount - 1 'boucle sur tous les éléments de la listbox "Comsprint1"
    'définit le texte T
    If Me.Comsprint2.Selected(I) = True Then T = IIf(T = "", "- " & Me.Comsprint2.List(I), T & Chr(10) & "- " & Me.Comsprint2.List(I))
Next I 'prochain élément de la boucle
DEST.Offset(0, 2).Value = T ' Enregistrement tu texte T

End Sub

tomover · 1 Octobre 2014

Re : Enregistrer listbox multiselection dans une seule cellule

Si je comprend bien l’élément à enregistrer se cale en fonction de la position de dernier enregistrement
il faut gérer les données dans l'ordre d'enregistrement (ordre des colonnes)
En effet je suis novice en VB et je regarde sur internet pour comprendre

Code:

Private Sub CommandButton1_Click()
Dim I As Integer 'déclare la variable I (Incrément)
Dim T As String 'déclare la variable T (Texte)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

' vérification de la saisie champ1
If Me.TextBox1.Text = "" Then
    MsgBox "Vous saisir le champ 1"
    Me.TextBox1.SetFocus
    Exit Sub
End If

' vérification de la saisie champ1
If Me.TextBox2.Text = "" Then
    MsgBox "Vous saisir le champ 2"
    Me.TextBox2.SetFocus
    Exit Sub
End If

'ENREGISTREMENT CHAMP 1 -------------------------
Set DEST = Sheets("bdd data").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
DEST.Value = TextBox1 ' Enregistrement du champ 1

'ENREGISTREMENT LIST A --------------------------
For I = 0 To Me.Comsprint1.ListCount - 1 'boucle sur tous les éléments de la listbox "Comsprint1"
    'définit le texte T
    If Me.Comsprint1.Selected(I) = True Then T = IIf(T = "", "- " & Me.Comsprint1.List(I), T & Chr(10) & "- " & Me.Comsprint1.List(I))
Next I 'prochain élément de la boucle
DEST.Offset(0, 1).Value = T ' Enregistrement tu texte T

T = "" 'réinitialise la variable T

'ENREGISTREMENT LIST B --------------------------
For I = 0 To Me.Comsprint2.ListCount - 1 'boucle sur tous les éléments de la listbox "Comsprint2"
    'définit le texte T
    If Me.Comsprint2.Selected(I) = True Then T = IIf(T = "", "- " & Me.Comsprint2.List(I), T & Chr(10) & "- " & Me.Comsprint2.List(I))
Next I 'prochain élément de la boucle
DEST.Offset(0, 2).Value = T ' Enregistrement tu texte T

T = "" 'réinitialise la variable T

'ENREGISTREMENT CHAMP 2 -------------------------
Set DEST = Sheets("bdd data").Range("A65536").End(xlUp).Offset(0, 3) 'définit la cellule de destination DEST
DEST.Value = TextBox2 ' Enregistrement du champ 1

End Sub

Merci beaucoup pour ton aide précieuse

tomover · 2 Octobre 2014

Re : Enregistrer listbox multiselection dans une seule cellule

C'est étrange quand j'intègre le code dans un document créer avec excel 2013 j'ai un message comme quoi l'objet de la bibliothèque est manquant ! !
Pourtant le fichier ci dessus fonctionne...

C'est le retour chariot qui merde Chr(10)

Bizarre bizarre...

tomover · 2 Octobre 2014

Re : Enregistrer listbox multiselection dans une seule cellule

J'ai remplacé par VBA.Chr(10) et visiblement ça fonctionne avec excel 2013

Effectuez une recherche sur Excel Downloads...

Enregistrer listbox multiselection dans une seule cellule

tomover

XLDnaute Nouveau

Pièces jointes

Robert

XLDnaute Barbatruc

tomover

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

tomover

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

tomover

XLDnaute Nouveau

tomover

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

tomover

XLDnaute Nouveau

tomover

XLDnaute Nouveau

tomover

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums