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
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
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
Oups, je ne sais pas faire....1 -Il faut insérer un ListBox (onglet développeur)
2 -Insérer le code(clic-droit sur le nom de l'onglet)
Boisgontier