Adaption code VBA - Menu à sélection multiple

Option Explicit

' constantes décrvant la configuration - à adapter

Const plageLB As String = "C7:C100"   ' plage à traiter
Const lideb As Byte = 6               ' ligne des fournitures
Const codeb As Byte = 3               ' premiere colonne fournitures
Const sep As String = " + "             ' séparateur - si tu preferes une foruniture par ligne
                                      ' tu mets vblf (pour line feed)

Dim interne As Boolean

Private Sub LbLIste_Change()
Dim ch As String, i As Long
If Not interne Then
  ch = ""
  For i = 0 To LbListe.ListCount - 1
    If LbListe.Selected(i) = True Then ch = ch & sep & LbListe.List(i)
  Next i
  ch = Mid(ch, Len(sep) + 1)
  ActiveCell = ch
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ch As String, ch2 As String, i As Long
Dim plage, topIndex As Boolean
Dim four As String, co As Long
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range(plageLB)) Is Nothing Then LbListe.Visible = False: Exit Sub
co = Target.Column
four = Cells(lideb, co).Value
plage = PlageListe(four)
If plage = False Then
  MsgBox "erreur : " & four & " n'est pas dans la feuille " & FL
  Exit Sub
End If
' initialiser listbox
LbListe.ListFillRange = FL & "!" & plage
LbListe.Top = Target.Top
LbListe.Left = Target.Offset(0, 1).Left
LbListe.Width = 100
LbListe.Height = LbListe.ListCount * (ActiveCell.Font.Size + 2) + 10
LbListe.MultiSelect = fmMultiSelectMulti
topIndex = False
' maj selection dans lbListe
interne = True    ' palliatif, EnableEvents ne marche pas
ch = ActiveCell
ch2 = sep & ch & sep
topIndex = False
For i = 0 To LbListe.ListCount - 1
  If InStr(ch2, LbListe.List(i)) > 0 Then
    ' l'item a été trouvé dans la cellule
    LbListe.Selected(i) = True
    If Not topIndex Then
      LbListe.topIndex = i    ' le 1er sélectionné doit être visible dans la textbox
      topIndex = True
    End If
  End If
Next i
interne = False
LbListe.Visible = True
End Sub

Option Explicit

' constantes décrvant la configuration

' Feuille Liste
Public Const FL As String = "Listes"    ' nom de la feuille
Public Const liFL As Byte = 1           ' ligne des fournitures

Public Function PlageListe(F As String)
Dim n As Byte, lifin As Byte, co As Byte, obj As Object
With Sheets(FL)
  Set obj = .Rows(liFL).Find(F, , , xlWhole)
  If obj Is Nothing Then PlageListe = False: Exit Function
  co = obj.Column
  lifin = .Cells(Rows.Count, co).End(xlUp).Row
  PlageListe = .Range(.Cells(liFL + 1, co), .Cells(lifin, co)).Address
End With
End Function

Sub reinit()
  Application.EnableEvents = True
End Sub