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> |
