Combobox et filtre automatique ( Fonctionne que pour les premiers choix!!!!)

Abdel2015

XLDnaute Nouveau
Bonjour ,

J'ai un problème mon code marche uniquement pour les premiers choix offerts par mon combobox , si je réalise un autre choix la valeur correspondante à ma colonne 12 est 0 et le filtre masque toutes les valeurs de mon tableau ??!!
ici mon code et mon fichier en pièce jointe



Code:
Option Explicit
'Définition des variables
Dim Ws As Worksheet
Dim NbLignes As Integer
Dim typalim As String
Dim modecon As String
Dim typf As String
Dim esp As String
Dim cycl As String
Dim appstad As String
Dim stad As String
Dim stadtyp As String
Dim ENT As Single
Dim AZOT As Single
Dim MINX As Single
Dim P As Single
Dim CA As Single

'ComboBox en cascade

Private Sub UserForm_Initialize()
    Set Ws = Worksheets("Feuil2")
    NbLignes = Ws.Range("A65536").End(xlUp).Row
    Alim_Combo 1
End Sub
Private Sub ComboBox1_Change()
    Alim_Combo 2, ComboBox1.Value
End Sub
Private Sub ComboBox2_Change()
    Alim_Combo 3, ComboBox2.Value
End Sub
Private Sub ComboBox3_Change()
    Alim_Combo 4, ComboBox3.Value
End Sub
Private Sub ComboBox4_Change()
    Alim_Combo 5, ComboBox4.Value
End Sub

Private Sub ComboBox5_Change()
    Alim_Combo 6, ComboBox5.Value
End Sub
Private Sub ComboBox6_Change()
    Alim_Combo 7, ComboBox6.Value
End Sub

Private Sub ComboBox7_Change()
End Sub

Private Sub Alim_Combo(CbxIndex As Integer, Optional Cible As Variant)
    Dim j As Integer
    Dim Obj As Control
    Set Obj = Me.Controls("ComboBox" & CbxIndex)
    Obj.Clear
    If CbxIndex = 1 Then
        For j = 2 To NbLignes
            Obj = Ws.Range("A" & j)
            If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("A" & j)
        Next j
    Else
        For j = 2 To NbLignes
            If Ws.Range("A" & j).Offset(0, CbxIndex - 2) = Cible Then
                Obj = Ws.Range("A" & j).Offset(0, CbxIndex - 1)
                If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("A" & j).Offset(0, CbxIndex - 1)
            End If
        Next j
   End If
   Obj.ListIndex = -1
End Sub

'Chercher la valeur d'une variable en fonction des valeurs de plusieurs variables

Sub CommandButton1_Click()

typalim = ComboBox1.Value
modecon = ComboBox2.Value
typf = ComboBox3.Value
esp = ComboBox4.Value
cycl = ComboBox5.Value
appstad = ComboBox6.Value
stad = ComboBox7.Value
   
 Dim Feuille As String
    Feuille = "Feuil2"
    If (Sheets(Feuille).AutoFilterMode = False) Then
        Sheets(Feuille).Cells.AutoFilter
    Else
        Sheets(Feuille).Cells.AutoFilter
        Sheets(Feuille).Cells.AutoFilter
End If

Feuille = "Feuil2"
Sheets(Feuille).Cells.AutoFilter Field:=1, Criteria1:=ComboBox1.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=2, Criteria1:=ComboBox2.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=3, Criteria1:=ComboBox3.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=4, Criteria1:=ComboBox4.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=5, Criteria1:=ComboBox5.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=6, Criteria1:=ComboBox6.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=7, Criteria1:=ComboBox7.Value, Operator:=xlFilterValues

ENT = Sheets("Feuil2").Columns(12).SpecialCells(xlCellTypeVisible).End(xlDown).Value

Range("A1").Select
Selection.Value = ENT
End Sub
Private Sub CommandButton2_Click()
Sheets("Feuil2").ShowAllData
End Sub

Merci d'avance !
 

Pièces jointes

  • Mon programme .xlsm
    40 KB · Affichages: 32

Dranreb

XLDnaute Barbatruc
Re : Combobox et filtre automatique ( Fonctionne que pour les premiers choix!!!!)

Bonsoir.
J'aurais une solution beaucoup plus rapide, avec choix possibles dans n'importe quel ordre, toutes listes classées dans les ComboBox et sans filtres.
Elle utiliserait 5 modules de service bien documentés par des commentaires guides d'utilisation, dont 3 de classe. Est-ce que ça vous intéresse ?
 

Dranreb

XLDnaute Barbatruc
Re : Combobox et filtre automatique ( Fonctionne que pour les premiers choix!!!!)

Alors voilà.
J'ai dû créer un nouveau classeur car le projet VBA semblait corrompu (fantômes dans Microsoft Excel Objets et noms VBA des objets Worksheet en désaccord avec les noms des feuilles Excel qu'ils représentaient).
 

Pièces jointes

  • CbxLiésAbdel2015.xls
    248 KB · Affichages: 48

Discussions similaires

Réponses
2
Affichages
203

Statistiques des forums

Discussions
312 111
Messages
2 085 395
Membres
102 882
dernier inscrit
Sultan94