Bonjour à tous,

Je dois avouer que je ne connais rien du tout en VBA et macro et pourtant je souhaite me créer un tableau de suivi pour le travail pour lequel je souhaite insérer des listes à choix multiple dans certaines cases.
J'ai consulter des forums, regardé des vidéos mais en ne connaissant pas du tout le VBA je n'arrive pas à adapter ce que je vois à mon besoin.

J'ai un gros tableau excel avec énormément de colonne. Pour les colonnes de H à N de mon onglet "Registre" (de la ligne 19 à 219) correspond des listes de choix que j'ai créé dans un onglet appelé "Listes".
J'ai trouvé une solution sur ce forum qui a l'air simple :
Nom : exemple tableau.png Affichages : 292 Taille : 126,1 Ko

Le code correspondant est le suivant :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
Option Explicit
 
Dim interne As Boolean, sep As String, multiSel As Long, lbxListeOK As Boolean
 
Private Sub LbxListe_Change()
    Dim ch As String, i As Long
    If Not interne Then
        ch = ""
        For i = 0 To lbxListe.ListCount - 1
            If lbxListe.Selected(i) = True And lbxListe.List(i) <> "" Then ch = ch & sep & lbxListe.List(i)
        Next i
        ch = Mid(ch, Len(sep) + 1)
        ActiveCell = ch
    End If
End Sub
 
Private Sub LbxListe_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' un clic droit désélectionne ou sélectionne l'ensemble de la liste
    Dim i As Long, state As Boolean
    If multiSel = 0 Then Exit Sub
    If Button = xlSecondaryButton Then  ' si clic-droit
        ' nb sélections
        state = True
        For i = 0 To lbxListe.ListCount - 1
            If lbxListe.Selected(i) Then state = False: Exit For
        Next i
        ' si aucune sélection sélectionner tout
        ' sinon désélectionner tout
        'If cpt = 0 Then state = True Else state = False
        interne = True    ' palliatif, EnableEvents ne marche pas
        For i = 0 To lbxListe.ListCount - 1
            lbxListe.Selected(i) = state
        Next i
        interne = False
    End If
    LbxListe_Change
End Sub
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' Création de la listBox
    Dim Obj As OLEObject
    If Target.Address = "$A$1" Then
        Cancel = True
        For Each Obj In ActiveSheet.OLEObjects
            If TypeName(Obj.Object) = "ListBox" Then
                If Obj.Name = "lbxListe" Then Exit Sub
            End If
        Next Obj
        ' créer
        ActiveSheet.OLEObjects.Add(ClassType:="Forms.ListBox.1", Link:=False, _
                    DisplayAsIcon:=False, Left:=200, Top:=200, Width:=90, Height:=108).Name = "lbxListe"
        MsgBox "lbxListe créée"
    End If
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'******** Constante à adapter **********************************************************
    Const FeuilleListe As String = "Listes"    ' nom de la feuille des listes à utiliser
'***************************************************************************************
 
    Dim ch As String, ch2 As String, i As Long
    Dim topIndex As Boolean
    Dim param, ref
    Dim lig As Long, dercol As Long, c As Range
 
    If Target.Count > 1 Then Exit Sub
    ' contrôles validité
    With Sheets(FeuilleListe)
        param = .[A1].CurrentRegion    ' paramètres d'utilisations des listes
        '1        , 2             , 3   , 4    , 5     , 6    , 7
        'Référence, Liste utilisée, Type, Width, Height, Multi, Sep
 
        For lig = 3 To UBound(param, 1)
            ref = Split(Mid(param(lig, 1), 2), "!")
            If ref(0) = Target.Parent.Name Then    ' test nom feuille d'appel
                If Not Intersect(Target, Range(ref(1))) Is Nothing Then    'test plage d'appel
                    dercol = .Cells(2, Columns.Count).End(xlToLeft).Column
                    ' test nom de liste
                    Set c = .Rows(1).Find("Listes", LookIn:=xlValues, Lookat:=xlWhole)
                    Set c = c.Offset(1).Resize(, dercol - c.Column + 1).Find(param(lig, 2), LookIn:=xlValues, Lookat:=xlWhole)
                    If c Is Nothing Then
                        MsgBox "Liste '" & param(lig, 2) & "' non trouvée.": lig = UBound(param, 1)
                    Else
                        'plage liste
                        Set c = c.Offset(1).Resize(.Cells(Rows.Count, c.Column).End(xlUp).Row - 2)
                        Exit For
                    End If
                End If
            End If
        Next lig
    End With
 
    ' ne plus afficher la textbox
    lbxListe.Visible = False
    If lig <= UBound(param, 1) Then
        ' initialiser listbox
        Select Case param(lig, 3)
        Case "ListBox"
            With lbxListe
                .ListFillRange = "'" & FeuilleListe & "'!" & c.Address
                .Top = Target.Offset(1, 0).Top
                .Left = Target.Offset(0, 1).Left
                If param(lig, 4) <> "" Then .Width = param(lig, 4)
                If param(lig, 5) <> "" Then .Height = param(lig, 5)
                multiSel = param(lig, 6)
                interne = True
                .MultiSelect = multiSel
                interne = False
                sep = param(lig, 7)
            End With
            interne = True    ' palliatif, EnableEvents ne marche pas
            ch = Target
            ch2 = sep & ch & sep
            topIndex = False
            ' sélectionner selon contenu cellule
            For i = 0 To lbxListe.ListCount - 1
                If InStr(ch2, sep & lbxListe.List(i) & sep) > 0 Then
                    ' l'item a été trouvé dans la cellule
                    lbxListe.Selected(i) = True
                    If Not topIndex Then
                        lbxListe.topIndex = i    ' le 1er sélectionné doit être visible dans la textbox
                        topIndex = True
                    End If
                End If
            Next i
            interne = False
            ' afficher textbox
            lbxListe.Visible = True
        End Select
    End If
End Sub
 
Sub reinit()
    Application.EnableEvents = True
End Sub
Même avec tout ça, je n'arrive pas à adapter mon tableau

Je ne sais pas si ma demande est claire mais je vous remercie par avance pour toute l'aide que vous pourrez m'apporter et me tiens à votre disposition pour tout complément d'information.

Merci à vous !

Agnès