Discussion :

[adamskone]

Bonjour à tous,

J'ai une macro qui me retourne une "Erreur d'exécution '1004': la méthode AutoFilter de la classe range à échoué".
Cette macro à pour but de filtrer un tableau par un autofiltre dont les critères sont recuperer dans la variable msg.

j'erreur apparait au niveau de la dernière ligne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
      Dim Msg As String
      Dim i, j As Integer
      j = 1
      Msg = "Criteria1:="
      For i = 0 To frm_filtrer.listbox1.ListCount - 1
        If frm_filtrer.listbox1.Selected(i) Then
               Msg = Msg & """=" & frm_filtrer.listbox1.List(i) & """,Operator:=xlOr, Criteria" & j + 1 & "=" '"""" & listbox1.list(i) & ""","
        End If
        j = j + 1
      Next i
      Msg = Left(Msg, Len(Msg) - 27) & " , Operator:=xlFilterValues"
 
      ActiveSheet.Range("$A$11").AutoFilter Field:=6 & ", " & Msg

Merci de votre aide.

[parmi]

Bonjour,

Si tu as plusieurs items à filtrer, tu dois passer par un tableau.
Utilise l'enregistreur de macro et filtre ta plage sur 3 items.
Ça te donnera une idée comment procéder.

[adamskone]

Merci Parmi pour ta réponse,j'ai utilisé l'enregistreur de macro pour générer une macro qui marche bien.
Mais quand je mets les critères de filtres dans ma variable et que je remplace les critères de la macro par cette variable,j'ai toujours le même message.

[parmi]

Essaie comme ceci pour voir

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
    Dim I As Long, Idx As Long
    Dim Tablo
 
    ReDim Tablo(0)
    For I = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(I) Then
            ReDim Preserve Tablo(Idx)
            Tablo(Idx) = CStr(I)
            Idx = Idx + 1
        End If
    Next
 
    ActiveSheet.Range("$A$11").AutoFilter Field:=6, Criteria1:=Tablo, Operator:=xlFilterValues

[adamskone]

J’ai essayé ton code Parmi.
Il n'y a pas d'erreur mais le filtre ne s'applique pas.
Ci-joint le fichier.
Analysis.xlsm

[parmi]

Désolé, j'avais utilisé la macro autrement pour fins de test et je n'avais pas corrigé.

Essaie ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Macro3()
 
    Dim I As Long, Idx As Long
    Dim Tablo
 
    ReDim Tablo(0)
    For I = 0 To frm_filtrer.listbox1.ListCount - 1
        If frm_filtrer.listbox1.Selected(I) Then
            ReDim Preserve Tablo(Idx)
            Tablo(Idx) = CStr(frm_filtrer.listbox1.List(I))
            Idx = Idx + 1
        End If
    Next
 
    ActiveSheet.Range("$A$11").AutoFilter Field:=6, Criteria1:=Tablo, Operator:=xlFilterValues
 
End Sub

[adamskone]

Merci Beaucoup Parmi. Ça marche
Mais je veux effectuer un test sur la listbox pour savoir si une sélection y est faite ou pas.

Si une sélection est faite
on exécute le tri
Sinon
on ne fait rien.

Parce que avec le précédant code même quand je ne fait aucun choix dans la listbox ,il y un filtre qui s’exécute.


Merci d'avance pour ton aide

[parmi]

Comme ceci ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Macro3()
 
    Dim I As Long, Idx As Long
    Dim Tablo
 
    ReDim Tablo(0)
    For I = 0 To frm_filtrer.listbox1.ListCount - 1
        If frm_filtrer.listbox1.Selected(I) Then
            ReDim Preserve Tablo(Idx)
            Tablo(Idx) = CStr(frm_filtrer.listbox1.List(I))
            Idx = Idx + 1
        End If
    Next
 
    If Not IsEmpty(Tablo(0)) Then
        ActiveSheet.Range("$A$11").AutoFilter Field:=6, Criteria1:=Tablo, Operator:=xlFilterValues
    End If
 
End Sub

[adamskone]

Ça marche Parmi.Vraiment mille merci pour aide.

j'ai ajouté deux autre listbox.Mais seulment deux fonctionnent et celle du milieu(Client) ne marche ,il n'y a pas de message d'erreur.

Trouve ci-joint un extrait du fichier.

Analysis 1.xlsm


Merci .

[parmi]

Essaie comme ceci.
Mais je ne comprends pas pourquoi la 2e liste se "désélectionne" et pas les 2 autres...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub choix()
 
'REGION
    Dim I As Long, Idx As Long
    Dim Tablo
    ReDim Tablo(0)
    For I = 0 To frm_filtrer.listbox1.ListCount - 1
        If frm_filtrer.listbox1.Selected(I) Then
            ReDim Preserve Tablo(Idx)
            Tablo(Idx) = CStr(frm_filtrer.listbox1.List(I))
            Idx = Idx + 1
        End If
    Next
 
 'CLIENTS
 Dim I1 As Long, Idx1 As Long
    Dim Tablo1
    ReDim Tablo1(0)
    For I1 = 0 To frm_filtrer.listbox2.ListCount - 1
        If frm_filtrer.listbox2.Selected(I1) Then
            ReDim Preserve Tablo1(Idx1)
            Tablo1(Idx1) = CStr(frm_filtrer.listbox2.List(I1))
            Idx1 = Idx1 + 1
        End If
    Next
 
 'CATEGORIE
 Dim I2 As Long, Idx2 As Long
    Dim Tablo2
    ReDim Tablo2(0)
    For I2 = 0 To frm_filtrer.listbox3.ListCount - 1
        If frm_filtrer.listbox3.Selected(I2) Then
            ReDim Preserve Tablo2(Idx2)
            Tablo2(Idx2) = CStr(frm_filtrer.listbox3.List(I2))
            Idx2 = Idx2 + 1
        End If
    Next
 
 If Not IsEmpty(Tablo(0)) Then
    ActiveSheet.Range("$A$11").AutoFilter Field:=6, Criteria1:=Tablo, Operator:=xlFilterValues
 Else
    ActiveSheet.Range("$A$11").AutoFilter Field:=6
 End If
 
 If Not IsEmpty(Tablo1(0)) Then
    ActiveSheet.Range("$A$11").AutoFilter Field:=10, Criteria1:=Tablo1, Operator:=xlFilterValues
 Else
    ActiveSheet.Range("$A$11").AutoFilter Field:=10
 End If
 
 If Not IsEmpty(Tablo2(0)) Then
    ActiveSheet.Range("$A$11").AutoFilter Field:=11, Criteria1:=Tablo2, Operator:=xlFilterValues
 Else
    ActiveSheet.Range("$A$11").AutoFilter Field:=11
 End If
 
 Unload Me 'facultatif
End Sub

[adamskone]

Grand merci Parmi.
Ça marche mais la 2e liste se "désélectionne" toujours toute seule.


dois je marquer le post "résolu" ou attendre que le problème de la liste qui se "désélectionne" seule soit résolu?

Merci infiniment pour ton support.

[parmi]

Peut-être que tu peux essayer en supprimant la listbox et la remplacer par une nouvelle avec le même nom.
Autrement, je dirais qu'il serait préférable d'ouvrir un nouveau message avec ce problème particulier.
Tu risques d'avoir d'autres gens pour t'aider...

Bonne continuation !

[adamskone]

ok.
Encore Merci pour ton aide.