[XL-2003] code liste déroulante [Résolu]

[hobine]

Bonjour,
j'ai reçu un code qui est supposé créer des listes déroulantes sur l'onglet "Listes" et par la suite sur un onglet quelconque, en réécrivant le nom de la liste créée sur une colonne, en cliquant sur la prochaine ligne de la même colonne l'on retrouve le contenu de cette liste.
Mais seulement elle ne fonctionne pas.
Un âme sensible pourra t il me sortir de cette galère, ça fait 3 jours que cela dure.
La macro se trouve dans le pièce jointe sur vba ThisWorkbook

cordialement

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
<s>Public Sub DefineList(ByVal Head As String)
 
Dim ws_list As Worksheet
Dim DebPlage As String, FinPlage As String, Plage As String
Dim Trouve As range
Dim ListName As String
 
Set ws_list = ThisWorkbook.Worksheets(Ws_Lists)
Set Trouve = ws_list.Rows(L_Lists_Head).Find(Head, LookIn:=xlValues, lookat:=xlWhole)
 
If Not Trouve Is Nothing Then
    DebPlage = "R2C" & Trouve.Column
    FinPlage = "R" & ws_list.range(DecAlph(Trouve.Column) & "3").End(xlDown).Row & "C" & Trouve.Column
    Plage = "=" & ws_list.Name & "!" & DebPlage & ":" & FinPlage
 
    ListName = "List_" & Replace(Head, " ", "_", 1, -1, vbTextCompare)
    ThisWorkbook.Names.Add Name:=ListName, RefersToR1C1:=Plage
End If
 
End Sub
 'générer une liste
 
Private Sub AuthorListCreator(ByVal CurrentRange As range)
'Créer une liste de choix lors d'un clic sur une case
 
Dim Head As String, ListName As String
Dim Trouve As range
Dim DebPlage As String, FinPlage As String, Plage As String
Dim ws_list As Worksheet
 
 
Set ws_list = ThisWorkbook.Worksheets(Ws_Lists)
 
With ActiveSheet
    Head = .Cells(L_Input_Head, Selection.Column)
    Set Trouve = ws_list.Rows(L_Author_Head).Find(Head, LookIn:=xlValues, lookat:=xlWhole)
    If Not Trouve Is Nothing Then
 
        ListName = "List_" & Replace(Head, " ", "_", 1, -1, vbTextCompare)
        Plage = "=" & ListName
 
        If ListExist(Plage) = False Then Call DefineList(Head)
 
        With CurrentRange.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=Plage
            .IgnoreBlank = False
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If
End With
 
End Sub
 
Public Function ListExist(ByVal Head As String) As Boolean
'Vérifie l'existence d'une liste
Dim n As Name
Dim ListName As String
 
For Each n In ThisWorkbook.Names
    ListName = "List_" & Replace(Head, " ", "_", 1, -1, vbTextCompare)
    If n.Name = ListName Then ListExist = True
Next n
End Function
 </s>