VBA EXCEL - Fonction qui renvoie une chaîne de caractères des éléments sélectionnés dans un ListBox,

Un billet blog de Philippe Tulliez

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Function GetSelectedValues(oListBox As MSForms.ListBox) As String 
  ' Renvoie une chaîne de caractères contenant tous les éléments sélectionnés dans un ListBox MultiSelected 
  ' Philippe Tulliez https://magicoffice.be 
  ' Argument 
  '   oListBox    Contrôle ListBox concerné 
  Dim Elem As Integer, Count As Integer 
  Dim tbl As Variant 
  ' Charge les éléments sélectionnés dans une table 
  With oListBox 
    For Elem = 0 To .ListCount - 1 
      If .Selected(Elem) Then 
         If Count Then ReDim Preserve tbl(Count) Else ReDim tbl(Count) 
         tbl(Count) = .List(Elem) 
         Count = Count + 1 
      End If 
    Next 
  End With 
  If IsArray(tbl) Then GetSelectedValues = Join(tbl, ";") 
End Function

1
2
3
4
5
6
7
8
9
Option Explicit 
  
Private Sub cmdCancel_Click() 
  Me.Hide 
End Sub 
  
Private Sub cmdOk_Click() 
  Me.Hide 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Main_Select() 
  Const TableName As String = "t_Fruit"         ' Nom de la table utilisée comme liste 
  Const LinkedCellName As String = "LinkedCell" ' Nom de la cellule cible 
  Dim rng As Range 
  Dim msg As String 
  Set rng = Range(TableName) 
  With usf_MultiSelect 
    With .ListBox1 
    .ColumnWidths = mUserForm_Manager.GetColumnWidths(rng) 
    .ColumnCount = rng.Columns.Count 
    .List = rng.Value 
    .MultiSelect = fmMultiSelectMulti    ' Définit la multisélection 
    .ListStyle = fmListStyleOption       ' Style Case à cocher 
    End With 
  .Show 
  msg = GetSelectedValues(.ListBox1) 
  MsgBox IIf(Len(msg), msg, "Pas de sélection"), Title:="Résultat de la sélection" 
  End With 
  Unload usf_MultiSelect 
  Set rng = Nothing 
End Sub