XL 2016 Limiter la Saisie dans un Combobox

[aurelio.ewane]

Bonjour jai un combobox qui contient une liste delements
Jaimerais savoir comment limiter la saisie dans mon combobx et n'autoriser que les valeurs qui sy trouvent du genre lorsque je commences a saisir une lettre ca charge dans mon combobox tous les elements de ma liste qui on se mot
une saisie intelligente je veux dire

Merci a tous

 

[Cousinhub]

Bonsoir,
@Dranreb

Qu'est ce que vous ne comprenez pas exactement ?

Est-ce que sérieusement, un "néophyte", pourrait "comprendre" quelque chose à ce code?
Edit : perso, moi non plus, j'y entrave que dalle...
Désolé pour la longueur du fil, mais....(Juste histoire de niveau en développement, je pense)

Option Explicit
Option Compare Text
Public TexteVide As String
Function SujetCBx(ByVal Src, Optional ByVal Croissant As Boolean = True, Optional ByVal Format As String = "", _
   Optional ByVal Base As Long = 1, Optional ByVal Colonne As Long = 1)
   Dim TDon(), K As Long, LesClés(), LesListes(), TIdx() As Long, X As Long, L As Long, Lignes() As Long, _
      TypA As Long, TypB As Long, ValA, ValB, N As Long, Rupture As Boolean
   If TexteVide = "" Then TexteVide = "(vide)"
   Select Case True
      Case TypeOf Src Is Range: If Src.Rows.Count > 1 Then TDon = Src.Columns(Colonne).Value _
         Else ReDim TDon(1 To 1, 1 To 1): TDon(1, 1) = Src.Columns(Colonne).Value
      Case TypeOf Src Is ListColumn: L = Src.Parent.ListRows.Count: If L > 1 Then TDon = Src.DataBodyRange.Value _
         Else ReDim TDon(1 To 1, 1 To 1): If L = 1 Then TDon(1, 1) = Src(1).Range.Value
      Case VarType(Src) = vbArray + vbVariant
         If UBound(Src, 2) <> 1 Or Colonne <> 1 Then
            If Colonne > UBound(Src, 2) Then MsgBox "Colonne " & Colonne & " > " & UBound(Src, 2), vbCritical, "SujetCBx": End
            ReDim TDon(1 To UBound(Src, 1), 1 To 1): For L = 1 To UBound(TDon, 1): TDon(L, 1) = Src(L, Colonne): Next L
         Else: TDon = Src: End If
      Case Else: MsgBox "Type de source """ & TypeName(Src) & """ non supportée.", vbCritical, "SujetCBx", vbCritical: End
      End Select
   ReDim LesClés(0 To &H3FF&), LesListes(0 To &H3FF&): K = -1
   IndexerFus1Col TIdx, TDon, Croissant
   X = 1: L = TIdx(1): GoSub TestRuptureEtMiseEnForme
   ReDim Lignes(Base To &H3FF&)
   Do While X <= UBound(TIdx): TypA = TypB: ValA = ValB: K = K + 1
      If K > UBound(LesClés) Then ReDim Preserve LesClés(0 To K Or &H1FF&), LesListes(0 To K Or &H1FF&)
      LesClés(K) = ValA: N = Base
      Do: Lignes(N) = L: X = X + 1: If X > UBound(TIdx) Then Exit Do
         L = TIdx(X): GoSub TestRuptureEtMiseEnForme: If Rupture Then Exit Do
         N = N + 1: If N >= UBound(Lignes) Then ReDim Preserve Lignes(Base To N Or &H1FF&) As Long
         Loop
      ReDim Preserve Lignes(Base To N) As Long
      LesListes(K) = Lignes: Loop
   ReDim Preserve LesClés(0 To K), LesListes(0 To K)
   SujetCBx = Array(LesClés, LesListes)
   Exit Function
TestRuptureEtMiseEnForme: ValB = TDon(L, 1): TypB = VarType(ValB)
   Select Case TypB
      Case vbBoolean: ValB = IIf(ValB, "VRAI", "FAUX")
      Case vbError: ValB = Choose((CInt(ValB) - 1993) \ 7, "#NUL!", "#DIV/0!", _
         "#VALEUR!", "#REF!", "#NOM?", "#NOMBRE!", "#N/A")
      Case vbEmpty: TypB = &H8000&: ValB = TexteVide
      Case Else: ValB = VBA.Format$(ValB, Format): End Select
   Rupture = TypB <> TypA: If Rupture Then Return
   Rupture = ValB <> ValA: Return
   End Function
Function SujCBxFiltré(ByVal SujOrg, Quoi() As Long)
   Dim TConsult() As Boolean, LesClés(), LesListes(), KS As Long, KE As Long, Lignes() As Long
   CréerTConsult TConsult, Quoi
   LesClés = SujOrg(0): LesListes = SujOrg(1): KS = -1
   For KE = 0 To UBound(LesClés)
      Lignes = LesListes(KE)
      If IlEnResteFiltrés(Lignes, TConsult) Then
         KS = KS + 1: LesClés(KS) = LesClés(KE): LesListes(KS) = Lignes: End If: Next KE
   If KS < 0 Then ReDim LesClés(-1 To -1), LesListes(-1 To -1) Else _
         ReDim Preserve LesClés(0 To KS), LesListes(0 To KS)
   SujCBxFiltré = Array(LesClés, LesListes)
   End Function
Function IlEnResteFiltrés(TLong() As Long, TConsult() As Boolean) As Boolean
   Dim R As Long, N As Long, L As Long
   R = LBound(TLong) - 1: On Error GoTo 2
   For N = LBound(TLong) To UBound(TLong)
      L = TLong(N): If TConsult(L) Then R = R + 1: TLong(R) = L
1     Next N: On Error GoTo 0
   If R >= LBound(TLong) Then ReDim Preserve TLong(LBound(TLong) _
      To R): IlEnResteFiltrés = True Else Erase TLong
   Exit Function
2  If Err.Number = 9 Then Resume 1 Else On Error GoTo 0: Resume 'Indice hors limites
   End Function
Function SujAvecSuivants(ByVal SujOrg)
   Dim LesClés(), LesListes(), NouvListes(), Ke1 As Long, Ke2 As Long, _
       TLe() As Long, TLs() As Long, NDéb As Long, N As Long
   LesClés = SujOrg(0): LesListes = SujOrg(1): ReDim NouvListes(0 To UBound(LesListes))
   For Ke1 = 0 To UBound(LesClés): TLs = LesListes(Ke1)
      For Ke2 = Ke1 + 1 To UBound(LesClés): TLe = LesListes(Ke2)
         NDéb = UBound(TLs): ReDim Preserve TLs(1 To UBound(TLe) + NDéb)
         For N = 1 To UBound(TLe): TLs(NDéb + N) = TLe(N): Next N, Ke2
      NouvListes(Ke1) = TLs: Next Ke1
   SujAvecSuivants = Array(LesClés, NouvListes)
   End Function
Function SujAvecPrécédents(ByVal SujOrg)
   Dim LesClés(), LesListes(), NouvListes(), Ke1 As Long, Ke2 As Long, _
       TLe() As Long, TLs() As Long, NDéb As Long, N As Long
   LesClés = SujOrg(0): LesListes = SujOrg(1): ReDim NouvListes(0 To UBound(LesListes))
   For Ke1 = 0 To UBound(LesClés): TLs = LesListes(0)
      For Ke2 = 1 To Ke1: TLe = LesListes(Ke2)
         NDéb = UBound(TLs): ReDim Preserve TLs(1 To UBound(TLe) + NDéb)
         For N = 1 To UBound(TLe): TLs(NDéb + N) = TLe(N): Next N, Ke2
      NouvListes(Ke1) = TLs: Next Ke1
   SujAvecPrécédents = Array(LesClés, NouvListes)
   End Function
Function SujCBxLike(ByVal SujOrg, ByVal Masque As String)
   Dim LesClés(), LesListes(), KS As Long, KE As Long
   Masque = UCase(Masque)
   LesClés = SujOrg(0): LesListes = SujOrg(1): KS = -1
   For KE = 0 To UBound(LesClés)
      If UCase(LesClés(KE)) Like Masque Then
         KS = KS + 1: If KS < KE Then LesClés(KS) = LesClés(KE): LesListes(KS) = LesListes(KE)
         End If: Next KE
   If KS < 0 Then Exit Function
   ReDim Preserve LesClés(0 To KS), LesListes(0 To KS)
   SujCBxLike = Array(LesClés, LesListes)
   End Function
Function SujetMotsClés(ByVal Src, Optional ByVal Séparat As String = " ")
   Dim CarEspac As String, N As Long, TDon(), LE As Long, Mot As String, TSpl() As String, LS As Long, _
      Mots() As Variant, LgnOrg() As Long, Sujet, LesListes() As Variant, TLgn() As Long, YEnAPas As Boolean
   CarEspac = "!""#$%&'()*+,-./:;<=>?@[\]^_`{|}~¡¦§¨«¬®¯»¿"
   For N = 1 To Len(Séparat): CarEspac = Replace$(CarEspac, Mid$(Séparat, N, 1), ""): Next N
   If TypeName(Src) = "Range" Then TDon = Src.Value Else TDon = Src
   For LE = 1 To UBound(TDon)
      Mot = TDon(LE, 1): For N = 1 To Len(Mot)
         If InStr(CarEspac, Mid$(Mot, N, 1)) > 0 Then Mid$(Mot, N, 1) = " "
         Next N
      TSpl = Split(Mot, Séparat)
      YEnAPas = True
      For N = 0 To UBound(TSpl): Mot = Trim$(TSpl(N))
         If Mot <> "" Then
            Mid$(Mot, 1, 1) = UCase$(Mid$(Mot, 1, 1)): LS = LS + 1: ReDim Preserve Mots(1 To LS), LgnOrg(1 To LS)
            Mots(LS) = Mot: LgnOrg(LS) = LE: YEnAPas = False: End If
         Next N
      If YEnAPas Then
         LS = LS + 1: ReDim Preserve Mots(1 To LS), LgnOrg(1 To LS)
         Mots(LS) = Empty: LgnOrg(LS) = LE: End If
      Next LE
   Sujet = SujetCBx(WorksheetFunction.Transpose(Mots))
   LesListes = Sujet(1)
   For N = LBound(LesListes) To UBound(LesListes)
      TLgn = LesListes(N)
      For LS = LBound(TLgn) To UBound(TLgn): TLgn(LS) = LgnOrg(TLgn(LS)): Next LS
      LesListes(N) = TLgn
      Next N
   SujetMotsClés = Array(Sujet(0), LesListes)
   End Function
Function SujMultiCol(ByVal Src, Optional ByVal CDéb As Integer = 1, Optional ByVal CFin _
   As Integer = &H7FFF, Optional ByVal Pas As Integer = 1, Optional ByVal Format As String)
   Dim TDon(), LDon As Long, CDon As Long, LAuxMax As Long, LAux As Long, TAuxClé(), TAuxLgn() As Long, _
      Sujet, LesListes(), N As Long, TLgn() As Long, L As Long
   If TypeOf Src Is Excel.Range Then TDon = Src.Value Else TDon = Src
   If CFin > UBound(TDon, 2) Then CFin = UBound(TDon, 2)
   For LDon = 1 To UBound(TDon, 1): For CDon = CDéb To CFin Step Pas
      If Not IsEmpty(TDon(LDon, CDon)) Then LAuxMax = LAuxMax + 1
      Next CDon, LDon
   ReDim TAuxClé(1 To LAuxMax, 1 To 1), TAuxLgn(1 To LAuxMax)
   For LDon = 1 To UBound(TDon, 1): For CDon = CDéb To CFin Step Pas
      If Not IsEmpty(TDon(LDon, CDon)) Then
         LAux = LAux + 1: TAuxClé(LAux, 1) = TDon(LDon, CDon): TAuxLgn(LAux) = LDon
         End If: Next CDon, LDon
   Sujet = SujetCBx(TAuxClé, Format:=Format)
   LesListes = Sujet(1)
   For N = 0 To UBound(LesListes): TLgn = LesListes(N)
      For L = 1 To UBound(TLgn): TLgn(L) = TAuxLgn(TLgn(L)): Next L
      LesListes(N) = TLgn: Next N
   SujMultiCol = Array(Sujet(0), LesListes)
   End Function
Function SujCBxClésSuppl(ByVal SujOrg, ByVal ClésSuppl As Variant)
   Dim Cln As Collection, Élé, LesClés(), LesListes(), K As Long
   If TypeOf ClésSuppl Is Range Then ClésSuppl = ClésSuppl.Value
   For Each Élé In ClésSuppl: Cln.Add Item:=CStr(Élé), Key:=CStr(Élé): Next Élé
   LesClés = SujOrg(0): LesListes = SujOrg(1)
   On Error Resume Next
   For K = 0 To UBound(LesClés): Cln.Remove LesClés(K): Next K
   On Error GoTo 0
   K = UBound(LesClés): ReDim Preserve LesClés(0 To K + Cln.Count), LesListes(0 To K + Cln.Count)
   For Each Élé In Cln: K = K + 1: LesClés(K) = Élé: Next Élé
   SujCBxClésSuppl = Array(LesClés, LesListes)
   End Function
Function TLgnLBx(ByVal LBx As MSForms.ListBox, Sujet) As Long()
   ÉtablirTLgnLBx TLgnLBx, LBx, Sujet
   End Function
Sub ÉtablirTLgnLBx(TLgn() As Long, ByVal LBx As MSForms.ListBox, ByVal Sujet)
   Dim LLBx As Long, TConsult() As Boolean, TLSuj() As Long
   For LLBx = 0 To LBx.ListCount - 1
      If LBx.Selected(LLBx) Then TLSuj = Sujet(1)(LLBx): CombinTConsultOU TConsult, TLSuj
      Next LLBx
   CréerListeVrais TLgn, TConsult
   End Sub
Function DicoSujet(ByVal Sujet) As Dictionary
   Set DicoSujet = New Dictionary
   Dim LesClés(), LesListes(), N As Long
   LesClés = Sujet(0): LesListes = Sujet(1)
   For N = 0 To UBound(LesClés)
      DicoSujet.Add Key:=LesClés(N), Item:=LesListes(N)
      Next N
   End Function
Function TConsult(TLong() As Long) As Boolean()
   CréerTConsult TConsult, TLong
   End Function
Sub CréerTConsult(TConsult() As Boolean, TLong() As Long)
   Erase TConsult: CombinTConsultOU TConsult, TLong
   End Sub
Sub CombinTConsultOU(TConsult() As Boolean, TLong() As Long)
   Dim N As Long, L As Long, LMin As Long, LMax As Long, LMnO As Long, LMxO As Long
   LMin = &H7FFFFFFF: LMax = -LMin
   For N = LBound(TLong) To UBound(TLong): L = TLong(N)
      If LMax < L Then LMax = L
      If LMin > L Then LMin = L
      Next N
   On Error Resume Next: LMnO = LBound(TConsult): LMxO = UBound(TConsult)
   If Err Then ReDim TConsult(LMin To LMax): LMnO = LMin: LMxO = LMax
   On Error GoTo 0
   If LMin < LMnO Then
      Dim T() As Boolean: T = TConsult
      ReDim TConsult(LMin To LMxO): For L = LMnO To LMxO: TConsult(L) = T(L): Next L
      LMnO = LMin: End If
   If LMax > LMxO Then ReDim Preserve TConsult(LMnO To LMax)
   For N = LBound(TLong) To UBound(TLong): L = TLong(N): TConsult(L) = True: Next N
   End Sub
Function ListeVrais(TConsult() As Boolean, Optional ByVal Base As Long = 1) As Long()
   CréerListeVrais ListeVrais, TConsult, Base
   End Function
Sub CréerListeVrais(TLong() As Long, TConsult() As Boolean, Optional ByVal Base As Long = 1)
   Dim L As Long, N As Long
   ReDim TLong(Base To UBound(TConsult) - LBound(TConsult) + Base): N = Base - 1
   For L = LBound(TConsult) To UBound(TConsult)
      If TConsult(L) Then N = N + 1: TLong(N) = L
      Next L: If N >= Base Then ReDim Preserve TLong(Base To N) Else Erase TLong
   End Sub
Sub IndexerFus1Col(TIdx() As Long, TDon(), _
   Optional ByVal Croissant As Boolean = True, Optional ByVal LMax As Long)
   Dim NR As Long, ÀFusionner As New Collection, _
       L1 As Long, TFus1() As Long, N1 As Long, Arg1, _
       L2 As Long, TFus2() As Long, N2 As Long, Arg2
   If LMax <= 0 Then LMax = UBound(TDon, 1)
   ReDim TIdx(1 To &HFFF&)
   NR = 1: TIdx(1) = 1: L1 = 1: Arg1 = TDon(1, 1)
   If VarType(Arg1) = vbString Then If Arg1 = "" Then Arg1 = Empty: TDon(1, 1) = Empty
   For L2 = 2 To LMax: Arg2 = TDon(L2, 1)
      If VarType(Arg2) = vbString Then If Arg2 = "" Then Arg2 = Empty: TDon(L2, 1) = Empty
      If DansLOrdre(Arg1, Arg2, Croissant, L1 < L2) Then
         NR = NR + 1: If NR > UBound(TIdx) Then ReDim Preserve TIdx(1 To NR Or &HFFF&)
         TIdx(NR) = L2: L1 = L2: Arg1 = Arg2
      ElseIf NR < 20 Then
         For N1 = 1 To NR - 1: L1 = TIdx(N1): If DansLOrdre(Arg2, TDon(L1, 1), Croissant, L1 > L2) Then Exit For
            Next N1
         NR = NR + 1: If NR > UBound(TIdx) Then ReDim Preserve TIdx(1 To NR Or &HFFF&)
         For N2 = NR To N1 + 1 Step -1: TIdx(N2) = TIdx(N2 - 1): Next N2
         TIdx(N1) = L2: L1 = TIdx(NR): Arg1 = TDon(L1, 1)
      Else: ReDim Preserve TIdx(1 To NR): ÀFusionner.Add TIdx: NR = 1
         TIdx(1) = L2: L1 = L2: Arg1 = Arg2: End If
      Next L2
   ReDim Preserve TIdx(1 To NR)
   Do While ÀFusionner.Count > 0
      ÀFusionner.Add TIdx
      TFus1 = ÀFusionner(1): N1 = 1: ÀFusionner.Remove 1
      TFus2 = ÀFusionner(1): N2 = 1: ÀFusionner.Remove 1
      ReDim TIdx(1 To UBound(TFus1) + UBound(TFus2))
      L1 = TFus1(1): Arg1 = TDon(L1, 1)
      L2 = TFus2(1): Arg2 = TDon(L2, 1)
      NR = 0: Do: NR = NR + 1
         If DansLOrdre(Arg1, Arg2, Croissant, L1 < L2) Then
               TIdx(NR) = L1: N1 = N1 + 1: If N1 <= UBound(TFus1) Then L1 = TFus1(N1): Arg1 = TDon(L1, 1) Else GoTo Fin2
         Else: TIdx(NR) = L2: N2 = N2 + 1: If N2 <= UBound(TFus2) Then L2 = TFus2(N2): Arg2 = TDon(L2, 1) Else Exit Do
            End If
         Loop
      Do: NR = NR + 1: TIdx(NR) = TFus1(N1): N1 = N1 + 1: Loop Until N1 > UBound(TFus1): GoTo FusS
Fin2: Do: NR = NR + 1: TIdx(NR) = TFus2(N2): N2 = N2 + 1: Loop Until N2 > UBound(TFus2)
FusS: Loop
   End Sub
Private Function DansLOrdre(ByVal Val1, ByVal Val2, ByVal Croissant As Boolean, ByVal ParDéf As Boolean) As Boolean
   Dim Typ1 As VbVarType, Typ2 As VbVarType, Sens As Integer, Comp As Integer
   Sens = 2 * -Croissant - 1
   Typ1 = VarType(Val1): Typ2 = VarType(Val2)
   Select Case Typ2
      Case Is <> Typ1: Comp = Sgn(Typ2 - Typ1)
      Case vbString: Comp = StrComp(Val2, Val1) * Sens
      Case vbError: Comp = Sgn(CLng(Val2) - CLng(Val1)) * Sens
      Case vbEmpty: Comp = 0
      Case Else: Comp = Sgn(Val2 - Val1) * Sens: End Select
   If Comp = 0 Then DansLOrdre = ParDéf Else DansLOrdre = Comp > 0
   End Function

 

[Dranreb]

Non, chaque ComboBox d'un UserForm est pour une seule colonne d'un tableau. Mais j'ai des modules de classes pour en lier plusieurs pour plusieurs colonnes d'un même tableau.
Vous devriez joindre un classeur montrant ce que vous avez et expliquer ce que vous voudriez faire.

@Cousinhub, le MSujetCBx est un module de service. Il n'y pas à y plonger pour savoir ce qu'il fait. Il constitue des Sujets et j'explique au poste #5 ce qu'est un Sujet.: c'est un Variant contenant un tableau à une dimension de 2 éléments, le 0 et le 1.
L'élément 0 est un tableau à une dimension basé 0 des clés. Ce tableau est directement affectable à la propriété List d'une ComboBox.
L'élément 1 est un tableau également à une dimension basé 0 des listes ne numéros de lignes correspondant aux clés. Chaque élément de ce tableau contient un tableau de Long basé 1 des numéros de lignes où la clé correspondante à été trouvée dans sa colonne du tableau.

Donc l'instruction L = SujTemp(1)(ComboBox1.ListIndex)(1) affecte à L le 1er (et seul ici) numéro de ligne trouvé dans la liste de rang donné par le ListIndex de la ComboBox dans la 2ème partie du SujTemp.

 

[Cousinhub]

Non, chaque ComboBox d'un UserForm est pour une seule colonne d'un tableau. Mais j'ai des modules de classes pour en lier plusieurs pour plusieurs colonnes d'un même tableau.
Vous devriez joindre un classeur montrant ce que vous avez et expliquer ce que vous voudriez faire.

@Cousinhub, le MSujetCBx est un module de service. Il n'y pas à y plonger pour savoir ce qu'il fait. Il constitue des Sujets et j'explique au poste #5 ce qu'est un Sujet.: c'est un Variant contenant un tableau à une dimension de 2 éléments, le 0 et le 1.
L'élément 0 est un tableau à une dimension basé 0 des clés. Ce tableau est directement affectable à la propriété List d'une ComboBox.
L'élément 1 est un tableau également à une dimension basé 0 des listes ne numéros de lignes correspondant aux clés. Chaque élément de ce tableau contient un tableau de Long basé 1 des numéros de lignes où la clé correspondante à été trouvée dans sa colonne du tableau.

OK, donc inutile de poser une quelconque question?
Ni surtout à essayer de comprendre?
On accepte, ou on passe?
Bref, et ce n'est que mon avis, toute adaptation demanderait ton intervention?
Fin pour moi sur ce fil, bonne démonstration d'un exemple de dépendance.....

 

[Dranreb]

Il n'est pas interdit de satisfaire une curiosité, mais ce n'est pas nécessaire pour l'utiliser. C'est par exemple comme la méthode Range de la bibliothèque Excel, il n'est pas nécessaire, ni même possible, d'étudier comment elle procède pour pouvoir l'utiliser: il suffit de bien comprendre ce qu'elle renvoie, et ce qu'on peut tirer de ce qu'elle renvoie. Et oui, on l'accepte comme elle est, on ne peut pas bricoler du code Microsoft.

 

[Dudu2]

Bonjour,
A l'occasion de ce sujet, dans la ressource pré-citée, j'ai placé la V7 (correction V4) qui gère les ComboBoxes multi-colonnes.
Il faut rappeler que dans ce cas, seule s'affiche dans la zone de saisie la colonne désignée par la propriété TextColumn. C'est bien sûr sur cette colonne que s'applique le filtrage de la saisie.
Ça aurait pu être très rapide si ce n'était un bug parmi tant d'autres en ComboBoxes consistant à générer l'évènement Change() en affectation de ComboBox.List et à effacer la zone de saisie quand TextColumn > 1 qu'il a donc fallu contourner.

Dans cet exemple ComboBox.TextColumn = 1 (ou -1 auquel cas je le force - abusivement - à 1)

 

[Dudu2]

Me suis planté dans les ressources...
C'est la V4 de la ressource que je viens d'enregistrer:

VBA - Saisie filtrée (alias saisie intelligente) en ComboBox

La "Saisie filtrée" sur ComboBox parfois dénommée "saisie intelligente" consiste à actualiser dynamiquement les valeurs d'une ComboBox au fur et à mesure de la saisie des caractères tout en permettant la sélection d'une valeur dans la liste...

excel-downloads.com

 

[aurelio.ewane]

n

Bonjour,
A l'occasion de ce sujet, dans la ressource pré-citée, j'ai placé la V7 (correction V4) qui gère les ComboBoxes multi-colonnes.
Il faut rappeler que dans ce cas, seule s'affiche dans la zone de saisie la colonne désignée par la propriété TextColumn. C'est bien sûr sur cette colonne que s'applique le filtrage de la saisie.
Ça aurait pu être très rapide si ce n'était un bug parmi tant d'autres en ComboBoxes consistant à générer l'évènement Change() en affectation de ComboBox.List et à effacer la zone de saisie quand TextColumn > 1 qu'il a donc fallu contourner.

Dans cet exemple ComboBox.TextColumn = 1 (ou -1 auquel cas je le force - abusivement - à 1)

Regarde la pièce jointe 1174555le code svp

 

[Dudu2]

Bonjour,
Je n'ai pas saisi le sens de ton message. Tu t'en sors ?

Pour compléter ce système, je pourrais y intégrer la ressource:

VBA - ComboBox Multi-Colonnes en UserForm - Afficher toutes les colonnes de l'item sélectionné

Le fichier à télécharger contient: Le Module_MultiColumnComboBox à importer dans le projet VBA. Le Module de Classe Class_MultiColumnLabel à importer dans le projet VBA. Le UserForm1 et sa ComboBox1 qui donne un exemple d'utilisation. Les...

excel-downloads.com

Au prix d'une modif pour remplacer le Label du TextColumn (tout est en Labels) par une TextBox pour pouvoir y saisir et en reporter la saisie en ComboBox. Je vais voir si j'arrive à faire ça.

 

[Dudu2]

En fait non, je ne peux pas faire ça car je ne peux / sais pas pré-coder un évènement d'un Control de UserForm créé dynamiquement. Excel ne fait pas le lien entre ce Control et le code prédéfini, ce qui se comprends car à la compilation le Control n'existe pas.

 

[Dranreb]

@Dudu2, utilise peut être un module de classe support analogue à mon ComboBoxMmbr, non ?

 

[Dudu2]

Oui, il faut que je regarde de ce coté-là.

 

[Dudu2]

Idéalement il faut que je joue sur le ZOrder des Labels disposés sur la zone Text de la ComboBox:
ComboBox_Click() -> Labels on TOP pour afficher toutes les colonnes via les Labels
LabelX_Click() -> Labels on BOTTOM pour afficher la zone Text de la ComboBox et permettre la saisie.

Si j'ai bien le contrôle sur ComboBox_Click(), je n'ai pas d'évènement LabelX_Click() car les LabelX son créés dynamiquement.

Alors est-ce que je peux créer une classe pour seulement intercepter par exemple un Label1_Click() d'un Label1 créé dynamiquement dans un UserForm existant ?

 

[Dudu2]

Bon, ça fonctionne mais ça m'oblige à avoir non plus 1 module à insérer dans le code, mais 1 module + 1 classe. Ce n'est pas majeur mais c'est moins simple. Maintenant je vais essayer d'intégrer les 2 bidules.

 

[patricktoulon]

re

Bonjour jai un combobox qui contient une liste delements
Jaimerais savoir comment limiter la saisie dans mon combobx et n'autoriser que les valeurs qui sy trouvent du genre lorsque je commences a saisir une lettre ca charge dans mon combobox tous les elements de ma liste qui on se mot
une saisie intelligente je veux dire

bonjour a tous
perso j'aimerais bien comprendre
là on part sur des controls dynamico et même une classe
tout ça pour un contrôle de saisie même dans une combobox
c'est quoi le but final du truc ?
sachant que:
on a la possibilité d’exécuter le code du change seulement si c'est le control actif si on veut
parti de là en mode entry none on a pa""s l'auto completion on teste donc dans une variable tableau

 

[Dranreb]

Information: Pour l'autre objet, le ControlsAssociés, ses membres sont définis à travers un module de classe d'interface, le CAsso, qui est implémenté dans 7 modules de classe de contrôles spécifiques.