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