Remplir une combobox d'un Userform word avec une BDD Excel

ComBoBox1	ComboBox2
Cat1	Cat1.a
	Cat1.b

Cat2	Cat2.1
	Cat2.2
	Cat2.3
	Cat2.4 etc...

ComBoBox1	ComboBox2	TextBox1
Cat1	Cat1.a	jvslkfbkl sdkvjsd vklsd v skdl vskl
	Cat1.b	dvbjsdklfbsf sdkv svsldv s vlsk vs

Cat2	Cat2.1	dfvsfsg fbebrg ergergegbn rtheheg
	Cat2.2	fgsfgsg gzgzgzgg bgzegb z rzvss
	Cat2.3	fjzsdf z vhzljv zv svsj v vz v
	Cat2.4 etc...	sdvnkdjn zklv zkjv zsv sld

Bonjour,

Un exemple en attaché qui devrait vous permettre de trouver comment faire et choisir entre liste déroulante (ComboBox), liste simple (ListBox) et liste vue (ListView). Il y a des avantages et inconvénients pour chacun.

Le code du formulaire pour ceux qui ne veulent pas tout enregistrer.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Option Explicit
 
Dim appExcel As New Excel.Application
Dim wBk As Excel.Workbook
Dim wSh As Excel.Worksheet
Dim rng As Excel.Range
 
'--- adapté de
'--- https://stackoverflow.com/questions/47528558/vba-excel-populate-listbox-with-multiple-columns
 
Private Sub ComboBox1_Change()
    Dim k As Long, LastRow As Long, rngArray, lItem As ListItem
    Set wSh = wBk.Worksheets(Me.ComboBox1.Value)
    LastRow = wSh.Range("A" & Rows.Count).End(xlUp).Row
    Set rng = wSh.Range("A1:B" & LastRow)
    rngArray = rng
    With Me.ListBox1
        .Clear
        .List = rngArray
        .TopIndex = 0
    End With
    With Me.ComboBox2
        .Clear
        .List = rngArray
        .ListIndex = 0
    End With
    With Me.ListView1
        .ListItems.Clear
        .Gridlines = True
        .HideColumnHeaders = False
        .LabelWrap = True
        .FullRowSelect = True
        .HideSelection = False
        With .ColumnHeaders     'Définit nombre de colonnes et Entêtes
            .Clear              'Supprime les anciens entêtes
            'Ajoute 2 colonnes et spécifie noms entêtes et largeur des colonnes
            .Add , , "Cat.", 20
            .Add , , "Descr.", 180
        End With
        .View = lvwReport
        For k = 1 To LastRow
            Set lItem = .ListItems.Add(Text:=rng(k, 1).Value)
            lItem.ListSubItems.Add Text:=rng(k, 2).Value
        Next k
    End With
End Sub
 
Private Sub ComboBox2_Change()
    Me.ListBox1.ListIndex = Me.ComboBox2.ListIndex
    On Error Resume Next    '--- erreur à l'initialisation
    Me.ListView1.ListItems(Me.ComboBox2.ListIndex + 1).Selected = True
End Sub
 
Private Sub ListBox1_Click()
    Me.ComboBox2.ListIndex = Me.ListBox1.ListIndex
    Me.TextBox1.Text = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
End Sub
 
Private Sub ListView1_Click()
    Me.TextBox2.Text = Me.ListView1.SelectedItem & vbLf & Me.ListView1.SelectedItem.SubItems(1)
    Me.ComboBox2.ListIndex = Me.ListView1.SelectedItem.Index - 1
End Sub
 
Private Sub Userform_initialize()
    Set wBk = appExcel.Workbooks.Open(ActiveDocument.Path & "\Catg.xlsx")
    appExcel.Visible = False
    For Each wSh In wBk.Sheets
        Me.ComboBox1.AddItem wSh.Name
    Next
    Me.ComboBox1.ListIndex = 0
End Sub
 
Private Sub UserForm_Terminate()
    wBk.Close
    appExcel.Quit
    Set wSh = Nothing
    Set wBk = Nothing
    Set appExcel = Nothing
End Sub

Les 2 fichiers, .docm et .xlsx, doivent se trouver dans le même dossier.

Cordialement.