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
| Sub FillList(Destination As ComboBox, Tab_Source As ListObject, Optional ConditionFTx As Boolean = False)
Dim StrSource As String
Dim isource As Long
Dim iList As Integer
Dim MemoMatchRequired As Boolean
Dim MemoStyle As fmStyle
Dim FTtest As Boolean
Dim NomColonne As String
Dim Tab_Colonne As Variant
Dim Tab_TypeFT As Variant
'On vide la destination
Destination.Clear
'On mémorise la politique utilisée avec ce combo
MemoMatchRequired = Destination.MatchRequired
MemoStyle = Destination.Style
'On désactive le matchRequired
Destination.MatchRequired = False
'On utilise le combo en downcombo, ça permet de pouvoir faire des saisies
Destination.Style = fmStyleDropDownCombo
'On élimine un éventuelle ";*" dans le tag (cas des champs permttant une recherche partielle
NomColonne = Replace(Destination.Tag, ";*", "")
'On Place les données de la colonne pointée par le tag du composant Destination dans un tableau interne
Tab_Colonne = Tab_Source.ListColumns(NomColonne).DataBodyRange.Cells.Value
'On fait la même chose pour la colonne Type
Tab_TypeFT = Tab_Source.ListColumns("Type").DataBodyRange.Cells.Value
'On boucle sur le contenu de la colonne (Tag est renseigné en mode design)
For isource = 1 To UBound(Tab_Colonne)
'On récupère le contenu de la valeur pointée
StrSource = Tab_Colonne(isource, 1)
'On ne tient pas compte des lignes vides
If StrSource <> "" Then
'On regarde la condition FT
ConditionFTx = Tab_TypeFT(isource, 1) = "FTS" Or Tab_TypeFT(isource, 1) = "FTA"
If Not ConditionFTx Or (ConditionFTx And FTtest) Then
'On place le contenu de la cellule dans le Combo pour le forcer à séléctionner cette entrée si elle est déjà dans sa list
Destination.Value = StrSource
'Si acune entrée n'est séléctionnée, c'est que ce mot n'existe pas dans la list
If Destination.ListIndex = -1 Then
'On en profite pour trier par liste alpha en plaçant ce nouvel item juste avant l'item contenant un texte "supérieur"
For iList = 0 To Destination.ListCount - 1
If Destination.List(iList) > StrSource Then
'On insert le nouvel item à cette place
Destination.AddItem StrSource, iList
'On quitte la boucle
Exit For
End If
Next
'On controle que l'item a été ajouté, si ça n'est pas le cas, on le place au bout de la list
'Ce sera vrai dans deux cas
'La liste est vide Destination.ListCount et iList vallent 0
'Le nouvelle item est "supérieur" à tous ceux déjà présent dans la liste
'On est donc arrivé au bout de la boucle For, iList vaut donc (Destination.ListCount - 1) + 1 car il s'appréter à faire une boucle en plus
' mais puisque sa valeur dépasse la borne haute qu'on lui a fixé (Destination.ListCount - 1), il ne retourne pas au début du For
' Donc iList = Destination.ListCount - 1 + 1 = Destination.ListCount
If iList = Destination.ListCount Then Destination.AddItem StrSource
End If
End If
End If
Next
'On ajoute une entrée vide si elle n'existe pas
'Destination.Value = ""
'If Destination.ListIndex = -1 Then
Destination.AddItem "", 0
'On remet en place la politique
Destination.MatchRequired = MemoMatchRequired
Destination.Style = MemoStyle
End Sub |
Re
Répondre avec citation
Tutoriel : 
Envoyé par Passepartout007
Partager