Bonjour,
J'ai récupéré une macro permettant de faire des sélections de choix multiple (dans une même cellule), et tout marche bien, cependant, quand j'essaie de généraliser la macro à toute la feuille je n'y arrive pas.
Le pire c'est que même pour deux lignes je n'y arrive pas.
Voici la macro :
Sub Worksheet_Change(ByVal Target As Range)
Dim range_validation As Range
Dim ancienne_valeur As String
Dim nouvelle_valeur As String
Dim x As Range
Dim y As Range
If Target.Count > 1 Then GoTo sortie
Set x = Range("10:10").Find("Applications", Range("IV10"), xlValues, xlWhole, 1, 1, False)
Set y = Range("10:10").Find("component", Range("IV10"), xlValues, xlWhole, 1, 1, False)
On Error Resume Next
Set range_validation = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo sortie
If range_validation Is Nothing Then GoTo sortie
If Intersect(Target, range_validation) Is Nothing Then
'il n'y a rien
Else
Application.EnableEvents = False
nouvelle_valeur = Target.Value
Application.Undo
ancienne_valeur = Target.Value
Target.Value = nouvelle_valeur
If Target.Column = x.Column Or y.Column Then 'le 1 est la colonne où se trouve les cellules à remplir avec les sélections (ici c'est la première colonne)
If ancienne_valeur = "" Then
'il n'y a rien
Else
If nouvelle_valeur = "" Then
'il n'y a rien
Else
Target.Value = ancienne_valeur & ", " & nouvelle_valeur
End If
End If
End If
End If
sortie:
Application.EnableEvents = True
End Sub
Pouvez-vous m'indiquer ou je fais une erreur.
Mille Mercis
J'ai récupéré une macro permettant de faire des sélections de choix multiple (dans une même cellule), et tout marche bien, cependant, quand j'essaie de généraliser la macro à toute la feuille je n'y arrive pas.
Le pire c'est que même pour deux lignes je n'y arrive pas.
Voici la macro :
Sub Worksheet_Change(ByVal Target As Range)
Dim range_validation As Range
Dim ancienne_valeur As String
Dim nouvelle_valeur As String
Dim x As Range
Dim y As Range
If Target.Count > 1 Then GoTo sortie
Set x = Range("10:10").Find("Applications", Range("IV10"), xlValues, xlWhole, 1, 1, False)
Set y = Range("10:10").Find("component", Range("IV10"), xlValues, xlWhole, 1, 1, False)
On Error Resume Next
Set range_validation = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo sortie
If range_validation Is Nothing Then GoTo sortie
If Intersect(Target, range_validation) Is Nothing Then
'il n'y a rien
Else
Application.EnableEvents = False
nouvelle_valeur = Target.Value
Application.Undo
ancienne_valeur = Target.Value
Target.Value = nouvelle_valeur
If Target.Column = x.Column Or y.Column Then 'le 1 est la colonne où se trouve les cellules à remplir avec les sélections (ici c'est la première colonne)
If ancienne_valeur = "" Then
'il n'y a rien
Else
If nouvelle_valeur = "" Then
'il n'y a rien
Else
Target.Value = ancienne_valeur & ", " & nouvelle_valeur
End If
End If
End If
End If
sortie:
Application.EnableEvents = True
End Sub
Pouvez-vous m'indiquer ou je fais une erreur.
Mille Mercis