Choix multiple dans liste déroulante

[noel33]

Bonjour à tous,

j’aimerai dans une même cellule ajouter plusieurs noms sélectionnés à partir d'une liste déroulante, est-ce possible:

Voir mon fichier que j'ai "forcé" pour l'explication.

D'avance merci ,

Bonne journée,

N.

 

[BOISGONTIER]

Bonjour,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Range("G9,G13,G17"), Target) Is Nothing And Target.Count = 1 Then
    Me.ListBox1.MultiSelect = fmMultiSelectMulti
    Me.ListBox1.List = Range("J9:J11").Value
    a = Split(Target, " ")
    If UBound(a) >= 0 Then
      For i = 0 To Me.ListBox1.ListCount - 1
        If Not IsError(Application.Match(Me.ListBox1.List(i), a, 0)) Then Me.ListBox1.Selected(i) = True
      Next i
    End If
    Me.ListBox1.Height = 50
    Me.ListBox1.Width = 100
    Me.ListBox1.Top = Target.Top
    Me.ListBox1.Left = Target.Left + Target.Width
    Me.ListBox1.Visible = True
  Else
      Me.ListBox1.Visible = False
  End If
End Sub

Private Sub ListBox1_Change()
 For i = 0 To Me.ListBox1.ListCount - 1
   If Me.ListBox1.Selected(i) = True Then temp = temp & Me.ListBox1.List(i) & " "
 Next i
 ActiveCell = Trim(temp)
End Sub

Boisgontier

 

[Robert]

Bonjour Noël, bonjour le forum,

Une petite usine à gaz à placer dans le composant Feuil1(Feuil1)...

Private AV As String 'déclare la variable AV (Ancienne Valeur)

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'au changement de sélection
'si le changement a lieu ailleurs qu'en G9, G13 ou G17, sort de la procédure
If Application.Intersect(Target, Application.Union(Range("G9"), Range("G13"), Range("G17"))) Is Nothing Then Exit Sub
AV = Target.Value 'récupère l'ancienne valeur de la cellule avant changement
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans la cellule
'si le changement a lieu ailleurs qu'en G9, G13 ou G17, sort de la procédure
If Application.Intersect(Target, Application.Union(Range("G9"), Range("G13"), Range("G17"))) Is Nothing Then Exit Sub
If Target.Value = "" Then AV = "" 'si la cellule est effacée, AV est vide
If AV <> "" Then 'condition : si AV n'est pas vide
    Application.EnableEvents = False 'empêche l'exécution des macro événementielles
    Target.Value = AV & " / " & Target.Value 'la valeur de la cellule devient l'ancienne valeur AV puis espace, slash, espace et nouvelle valeur
End If 'fin de la condition
Application.EnableEvents = True 'autorise l'exécution des macro événementielles
Target.Offset(1, 0).Select: Target.Select 'déclale la cellule active d'une ligne vers le bas puis revient à la cellule modifié (le but est de mettre a jour la variable AV Ancienne Valeur)
End Sub

[Édition]
Bonjour Maître Jacques, nos posts se sont croisés... Toujours autant impressionnant !...

 

[job75]

Bonjour noel33, JB, Robert,

Voyez le fichier joint et cette macro à placer dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, nom$
Set cel = [G9]
If Intersect(Target, cel) Is Nothing Or cel = "" Then Exit Sub
nom = cel
Application.EnableEvents = False 'désactive les évènements
Application.Undo 'annule l'entrée
If cel = "" Or cel = nom Then GoTo 1
If MsgBox("Concaténer les noms ?", 4) = 6 Then cel = cel & "/" & nom: GoTo 2
1 Application.Undo 'rétablit l'entrée
2 Application.EnableEvents = True 'réactive les évènements
End Sub

A+

 

[noel33]

Bonjour à tous, et merci pour ces multiples réponses. Mon choix se porte sur
Boisgontier, mais je n'arrive pas à l’insérer dans mon vrai fichier...

 

[noel33]

Boisgontier, tu as une idée?

N.

 

[BOISGONTIER]

1 -Il faut insérer un ListBox (onglet développeur)
2 -Insérer le code(clic-droit sur le nom de l'onglet)

Boisgontier

 

[noel33]

1 -Il faut insérer un ListBox (onglet développeur)
2 -Insérer le code(clic-droit sur le nom de l'onglet)

Boisgontier

Oups, je ne sais pas faire....

 

[BOISGONTIER]

cf PJ

 

[noel33]

Extra!

Merci beaucoup,

N.