XL 2013 Relier les combobox de filtre

roross

XLDnaute Junior
Bonsoir,

comment relier combobx1,combobx2,combobx3,combobx4,combobx5 pour faire filtre ensemble
 

Pièces jointes

  • Filtre.xlsm
    28.8 KB · Affichages: 8

Dranreb

XLDnaute Barbatruc
J'obtiens déjà un résultat qui me semble conforme à ce que vous cherchez, après avoir coché la référence à CLsCAs, en remplaçant toute votre programmation par ceci :
VB:
Option Explicit
Private WithEvents CL As ComboBoxLiées
Private Sub UserForm_Initialize()
   Dim C As Long
   Set CL = CLsCAs.ComboBoxLiées
   CL.Plage Feuil1.[A2:D2], True
   For C = 1 To 3: CL.Add Me("ComboBox" & C), C: Next C
   For C = 4 To 5: CL.Add Me("ComboBox" & C): Next C
   CL.Actualiser
   End Sub
Private Sub CL_SujBdDPersoSVP(ByVal CBM As CLsCAs.ComboBoxMmbr)
   Dim SujBrut
   SujBrut = CLsCAs.SujetCBx(CL.PlgTablo.Columns(4))
   If CBM.CBx Is Me.ComboBox4 Then
      CBM.SujetBdD = CLsCAs.SujAvecSuivants(SujBrut)
   Else
      CBM.SujetBdD = CLsCAs.SujAvecPrécédents(SujBrut)
      End If
   End Sub
Private Sub CL_Résultat(Lignes() As Long)
   Dim TDon(), LDon&, TLBx(), LLBx&, C&
   ReDim TLBx(1 To UBound(Lignes), 1 To 4)
   TDon = CL.PlgTablo.Value
   For LLBx = 1 To UBound(TLBx)
      LDon = Lignes(LLBx)
      For C = 1 To 4: TLBx(LLBx, C) = TDon(LDon, C): Next C, LLBx
   ListBox1.List = TLBx
   End Sub
 

Dranreb

XLDnaute Barbatruc
Programmation complétée pour tenir compte du bouton TOUT :
VB:
Option Explicit
Private WithEvents CL As ComboBoxLiées
Private Sub UserForm_Initialize()
   Dim C As Long
   Set CL = CLsCAs.ComboBoxLiées
   CL.Plage Feuil1.[A2:D2], True
   For C = 1 To 3: CL.Add Me("ComboBox" & C), C: Next C
   For C = 4 To 5: CL.Add Me("ComboBox" & C): Next C
   CL.Actualiser
   End Sub
Private Sub CL_SujBdDPersoSVP(ByVal CBM As CLsCAs.ComboBoxMmbr)
   Dim SujBrut
   SujBrut = CLsCAs.SujetCBx(CL.PlgTablo.Columns(4))
   If CBM.CBx Is Me.ComboBox4 Then
      CBM.SujetBdD = CLsCAs.SujAvecSuivants(SujBrut)
   Else
      CBM.SujetBdD = CLsCAs.SujAvecPrécédents(SujBrut)
      End If
   End Sub
Private Sub cbtout_Click()
   CL.Nettoyer
   End Sub
Private Sub CL_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
   Dim TLgn() As Long, L As Long
   If NbrLgn > 0 Then Exit Sub
   ReDim TLgn(1 To CL.PlgTablo.Rows.Count)
   For L = 1 To UBound(TLgn): TLgn(L) = L: Next L
   CL_Résultat TLgn
   End Sub
Private Sub CL_Résultat(Lignes() As Long)
   Dim TDon(), LDon&, TLBx(), LLBx&, C&
   ReDim TLBx(1 To UBound(Lignes), 1 To 4)
   TDon = CL.PlgTablo.Value
   For LLBx = 1 To UBound(TLBx)
      LDon = Lignes(LLBx)
      For C = 1 To 4: TLBx(LLBx, C) = TDon(LDon, C): Next C, LLBx
   ListBox1.List = TLBx
   End Sub
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,


Exemple

Sans titre.png



Boisgontier
 

Pièces jointes

  • FormFiltre2.xls
    103 KB · Affichages: 9
Dernière édition:

roross

XLDnaute Junior
Programmation complétée pour tenir compte du bouton TOUT :
VB:
Option Explicit
Private WithEvents CL As ComboBoxLiées
Private Sub UserForm_Initialize()
   Dim C As Long
   Set CL = CLsCAs.ComboBoxLiées
   CL.Plage Feuil1.[A2:D2], True
   For C = 1 To 3: CL.Add Me("ComboBox" & C), C: Next C
   For C = 4 To 5: CL.Add Me("ComboBox" & C): Next C
   CL.Actualiser
   End Sub
Private Sub CL_SujBdDPersoSVP(ByVal CBM As CLsCAs.ComboBoxMmbr)
   Dim SujBrut
   SujBrut = CLsCAs.SujetCBx(CL.PlgTablo.Columns(4))
   If CBM.CBx Is Me.ComboBox4 Then
      CBM.SujetBdD = CLsCAs.SujAvecSuivants(SujBrut)
   Else
      CBM.SujetBdD = CLsCAs.SujAvecPrécédents(SujBrut)
      End If
   End Sub
Private Sub cbtout_Click()
   CL.Nettoyer
   End Sub
Private Sub CL_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
   Dim TLgn() As Long, L As Long
   If NbrLgn > 0 Then Exit Sub
   ReDim TLgn(1 To CL.PlgTablo.Rows.Count)
   For L = 1 To UBound(TLgn): TLgn(L) = L: Next L
   CL_Résultat TLgn
   End Sub
Private Sub CL_Résultat(Lignes() As Long)
   Dim TDon(), LDon&, TLBx(), LLBx&, C&
   ReDim TLBx(1 To UBound(Lignes), 1 To 4)
   TDon = CL.PlgTablo.Value
   For LLBx = 1 To UBound(TLBx)
      LDon = Lignes(LLBx)
      For C = 1 To 4: TLBx(LLBx, C) = TDon(LDon, C): Next C, LLBx
   ListBox1.List = TLBx
   End Sub

Bonjour,
Je te remercie et bonne chance
 

roross

XLDnaute Junior
Bonsoir.
Installez cette ressource, elle fait ça tout seul.
[/QUOTE

Bonsoir,

CBxLCtlA.xlam sa marche pas
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
S'il n'y a pas de tableau dynamique:

VB:
  Set f = Sheets("bd")
  Set Rng = f.Range("A2:D" & f.[A65000].End(xlUp).Row)     ' à adapter
  nomTableau = "Tableau1"
  ActiveWorkbook.Names.Add Name:=nomTableau, RefersTo:=Rng
  TblBD = Range(nomTableau).Value

Boisgontier
 

Pièces jointes

  • FormFiltre2.xls
    103 KB · Affichages: 12

Discussions similaires

Réponses
69
Affichages
3 K
Réponses
1
Affichages
410

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T