Créer liste déroulante à sélection multi plusieurs colonnes
Bonjour !
Je m'y connais très peu en VBA !
J'ai parcouru le forum et je suis tombée sur le sujet "Comment créer une liste déroulante à sélection multiple
où figure un code permettant de sélectionner, un par un, plusieurs choix d'une même liste déroulante :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ValSaisie
Dim P As Integer
If Not Intersect(Columns("F"), Target) Is Nothing And Target.Count = 1 And Target.Row > 1 Then
Application.EnableEvents = False
ValSaisie = Target
Application.Undo
P = InStr(Target, ValSaisie)
If P > 0 Then
Target = Left(Target, P - 1) & Mid(Target, P + Len(ValSaisie) + 1)
If Right(Target, 1) = "," Then
Target = Left(Target, Len(Target) - 1)
End If
Else
If Target = "" Then
Target = ValSaisie
Else
Target = Target & "," & ValSaisie
End If
End If
Application.EnableEvents = True
End If
End Sub
Seulement, je possède un tableau ou cette liste déroulante apparaît sur 5 colonnes "Equipes" (colonnes C F H J et L) avec le nom de plusieurs personnes. Je ne trouve pas les modifications à apporter au code pour qu'il fonctionne sur 5 colonnes et non pas une seule.. J'imagine que c'est sur la ligne que j'ai mis en gras mais que dois-je faire ?
En vous remerciant par avance pour le temps que vous consacrerez à mon problème...
Bonsoir,
Peut être
If Not Intersect(Range("C2:C100,F2:F100,H2:H100"), Target) Is Nothing Then
Une autre façon:
http://boisgontierjacques.free.fr/fichiers/DonneesValidation/DVChoixMultListBox.xls
Ceuzin
Super ! Merci votre solution fonctionne ! votre deuxième solution par contre ne fonctionne pas car on me dit qu'il ne reconnais pas la commande
"Private Sub Worksheet_SelectionChange"
tant pis, la première solution me convient ! seulement si la première fonctionne, mon autre code me permettant d'effacer mon tableau ne fonctionne pas... mon code est le suivant :
"Sub effacer()
Worksheets("Planning Hebdo Colisage Modele").Range("C11:L29").ClearContents
End Sub"
lorsque je rentres mes données avec votre code qui fonctionne, je clique su le bouton que j'ai installé lié à mon code "effacer" ci dessus, et là mode débogage qui me renvoie à cette ligne du premier code :
"Private Sub Worksheet_Change(ByVal Target As Range)
Dim ValSaisie
Dim P As Integer
If Not Intersect(Range("C2:C100,F2:F100,H2:H100"), Target) Is Nothing Then
Application.EnableEvents = False
ValSaisie = Target
Application.Undo
P = InStr(Target, ValSaisie)
If P > 0 Then
Target = Left(Target, P - 1) & Mid(Target, P + Len(ValSaisie) + 1)
If Right(Target, 1) = "," Then
Target = Left(Target, Len(Target) - 1)
End If
Else
If Target = "" Then
Target = ValSaisie
Else
Target = Target & "," & ValSaisie
End If
End If
Application.EnableEvents = True
End If
End Sub
mes deux codes entrent en conflit et je ne sais que faire. Merci encore une fois pour votre dévouement !
Bonjour,
Peut être
If Not Intersect(Range("C2:C100,F2:F100,H2:H100"), Target) Is Nothing And Target.Count=1 Then
Ceuzin
Super finalement tout marche ! Merci beaucoup Ceuzin !! bonne journée !!