Ajout d'un nouveau combobox avec recherche intuitive

[Aragon10]

Bonjour le forum,

Je voudrais ajouter un nouveau combobox (combobox2) sur mon userform existant et qui s'alimente de la Feuille "CD1" qui avait la même structure que la feuille une "CD" . je sollicite garder les mêmes caractéristiques du combobox1 (recherche intuitive+ sans doublons+ordre alphabétique+ liaison direct avec la listbox 2).

la première étape du travail est faite par Mr Dranreb que je le remercie énormément.

Document Cjoint



Merci pour votre aide.

 

[Dranreb]

Re : Ajout d'un nouveau combobox avec recherche intuitive

Bonjour.
C'est comme le rappel de la source, CD ou DAT, je l'attendais aussi celle là !
C'est bien pour ça que je vous avais demandé si vous vouliez bien tous les CD d'abord puis les DAT ensuite.
Par ordre décroissant, comme la tendance des feuilles données :

Private Sub UserForm_Initialize()
Dim TbCD(), TDAT(), TInt(), Le&, Ls&, C&
TextBox1.Text = Date
TbCD = PlgUti(FeuiCD.Rows(3)).Value
TDAT = PlgUti(FeuiDAT.Rows(3)).Value
ReDim TInt(1 To UBound(TbCD) + UBound(TDAT), 1 To 19)
For Le = 1 To UBound(TbCD): Ls = Ls + 1: TInt(Ls, 1) = TbCD(Le, 2): TInt(Ls, 2) = TbCD(Le, 1)
   TInt(Ls, 3) = TbCD(Le, 22): For C = 4 To 19: TInt(Ls, C) = TbCD(Le, C - 1): Next C, Le
For Le = 1 To UBound(TDAT): Ls = Ls + 1: TInt(Ls, 1) = TDAT(Le, 2): TInt(Ls, 2) = TDAT(Le, 1)
   TInt(Ls, 3) = TDAT(Le, 26): For C = 4 To 19: TInt(Ls, C) = TDAT(Le, C - 1): Next C, Le
ReDim TDon(1 To Ls, 1 To 19): Ls = 0
With New TableIndex
   .Init 1, UBound(TInt): While .Actif: .BInfA = TInt(.B, 2) > TInt(.A, 2): Wend
   .Parcourir: While .Actif: Ls = Ls + 1: Le = .Suivant
      For C = 1 To 19: TDon(Ls, C) = TInt(Le, C): Next C: Wend: End With
SujPrinc = SujetCBx(TDon, Base:=0)
Sujet = SujPrinc: ComboBox1.List = Sujet(0)
End Sub

 

[Aragon10]

Re : Ajout d'un nouveau combobox avec recherche intuitive

1000000 Merci pour le plus grand sauveur de la planète 🙂)))

 

[Aragon10]

Re : Ajout d'un nouveau combobox avec recherche intuitive

Bonjour Dranreb,

J'ai testé votre dernier code mais l'ordre trié par date n'est pas respecté (Merci d'essayer le client SAM dans le combo et vous allez constaté que le mois de janvier est affiché en premier dans la listbox avant le mois de juillet).ci-joint mon fichier:
Regarde la pièce jointe SujCBxAragon10.xlsm

Merci d'avance.

 

[Dranreb]

Re : Ajout d'un nouveau combobox avec recherche intuitive

Bonjour.

À destination des valeurs de cellules, prenez soin de convertir en Date à l'aide de la fonction CDate, les Text de la TextBox devant figurer une date affichée.
Actuellement certains sont Date mais d'autres String. Les données de chaque type sont séparées en 2 paquets dans la ListBox.

Même problème avec des montants: certains sont en String au lieu d'être en Double ou en Currency. Utilisez les fonctions CDbl ou CCur pour convertir les textes qui n'en sont que des représentations symbolique visuelles dans les TextBox.

Pour vous aider à vérifier la nature exacte des donnée stockées dans les cellules par Excel (qui n'a jamais affiché d'indication claire à ce sujet), vous pouvez utiliser cette fonction personnalisée dans les feuilles en cours d'élaboration:

Function TypeDon(ByVal Cel As Range) As String
TypeDon = TypeName(Cel.Value)
End Function

 

[Aragon10]

Re : Ajout d'un nouveau combobox avec recherche intuitive

Salut,

c'est exactement ça. j'ai utilisé ce petit code pour convertir les dates format string en DATE et ça marche très bien:

Sub Convert() 
With Columns("D:D")
   .Insert Shift:=xlToRight
   '.select '' ne pas mettre dans le code surtout,
   ''à activer pour compréhension de la suite si besoin...
   ''le with column("D:D") pointe vers la colonne E apparente suite à l'insertion,
   ''mais qui représente toujours l'objet d'origine à savoir la colonne pointée via l'instruction With...
   .Offset(0, -1).FormulaR1C1 = "=IF(RC[1]<>"""",RC[1]*24/24,"""")"
   .Offset(0, -1).NumberFormat = "m/d/yyyy"
   .Offset(0, -1).Copy
   .Offset(0, -1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   .Delete
End With
End Sub

Merci pour votre aide.