Discussion :

[Peerl]

Salut

Je travail sur un projet : Recherche Multi-Critères sur une feuille qui se trouve dans plusieurs classeur sous le même nom , y'a que les chiffres qui changent mais pas la structures du tableau ni les entêtes/titres .

Pour l'instant , ce que j'ai pu avoir comme idée : lister les fichiers dans une ComboBox puis une fois le classeur est sélectionné, une autre comboBox aura les noms de tout les feuilles du classeur, pour que l'utilisateur puisse choisir la feuille concernée ET ENSUITE effectuer la recherche Multi-Critères sur cette feuille ( les autres comboBox se remplissent avec les entêtes du tableau de la feuille choisi = critères ) .

Première étapes est de pouvoir lister les fichiers dans ma ComboBOX :

Code :

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

1
2
3
Private Sub UserForm_Initialize()
Call RechercheClasseursSurDisque
End Sub

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
Sub RechercheClasseursSurDisque()
Dim Classeurs() As String, I As Long
With Application.FileSearch
    .NewSearch
    .FileType = msoFileTypeExcelWorkbooks
    .LookIn = " "   '  Ici on met le chemin
    .SearchSubFolders = True
    .Execute
    With .FoundFiles
        ReDim Classeurs(1 To .Count, 1 To 1)
        For I = 1 To .Count
        Classeurs(I, 1) = .Item(I)
        Liste_Classeur.Classeur.AddItem .Item(I)
        Next I
        Application.ScreenUpdating = False
        With Range("A1").Resize(.Count)
            .Value = Classeurs
            .Sort [A1]
        End With
    End With
End With
End Sub

et j'ai une erreur :

Pièce jointe 383014

qui pointe sur :

Code :

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

With Application.FileSearch

Puis je avoir une explication sur cette erreur ?

si vous avez d'autres idées concernant ce projet n’hésitez pas SVP...


Merci Bonne journée

[a_diard]

Proposition pour la première étape
pour repertoire c'est au choix.

Code :

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

1
2
3
4
5
6
7
8
9
Sub UserForm_Initialize()
Dim fichierorigine As String, nf As String, repertoire As String
repertoire = ThisWorkbook.Path & "\" '
nf = Dir(repertoire & "*.xls")
Do While nf <> ""
    Me.cbliste.AddItem nf
    nf = Dir
Loop
End Sub

pour la question : Puis je avoir une explication sur cette erreur ?

FileSearch ne fonctionne que jusqu'à la version excel 2003

[Peerl]

Proposition pour la première étape
pour repertoire c'est au choix.

Code :

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

1
2
3
4
5
6
7
8
9
Sub UserForm_Initialize()
Dim fichierorigine As String, nf As String, repertoire As String
repertoire = ThisWorkbook.Path & "\" '
nf = Dir(repertoire & "*.xls")
Do While nf <> ""
    Me.cbliste.AddItem nf
    nf = Dir
Loop
End Sub

Entre temps j'avais essayé ça aussi et ça a bien fonctionné mais là je voulais re-tester ( juste afficher le formulaire qui charge tout les fichiers dans ma listbox ou comboBox mais ça ne fonctionne plus il me met fichier introuvable !

Merci

[Peerl]

Proposition pour la première étape
pour repertoire c'est au choix.

Code :

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

1
2
3
4
5
6
7
8
9
Sub UserForm_Initialize()
Dim fichierorigine As String, nf As String, repertoire As String
repertoire = ThisWorkbook.Path & "\" '
nf = Dir(repertoire & "*.xls")
Do While nf <> ""
    Me.cbliste.AddItem nf
    nf = Dir
Loop
End Sub

pour la question : Puis je avoir une explication sur cette erreur ?

FileSearch ne fonctionne que jusqu'à la version excel 2003

ah d'accord .

Bon j'ai recommencer depuis le début et apparemment ça marche parfaitement bien. Merci

[Peerl]

re coucou les amis

avec ce code j'essaie de remplir le LISTBOX / ComboBox des feuilles d'un classeur sélectionné dans LISTBOX/COMBOBOX des classeurs déjà listé :

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
Option Explicit
 
Private WB As Workbook
Dim f As Worksheet
 
Private Sub ListBox1_Click()
 
ListBox2.Clear
 
If ListBox1.ListIndex <> "" Then
 
  For Each f In WB.Worksheets
        ListBox2.AddItem f.Name
    Next f
End If
End Sub

mais j'ai une erreur variable objet ou variable bloc with non défini sur la ligne :

Code :

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

For Each f In WB.Worksheets

ça se trouve ce n'est pas logique ce que je viens d'écrire ?

[Peerl]

Bonjour tout le monde ,

J'ai trouvé une solution à ce problème voici le nouveau CODE qui permet de lister les fichiers et leurs onglets aux choix : ENJOY

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Dim Dossier As String
Dim Existe As Boolean
 
Private Sub UserForm_Activate()
 
    Dim Tbl() As String
 
    If MsgBox("Voulez-vous faire le choix du dossier où se trouvent les classeurs ?", _
              vbQuestion + vbYesNo, _
              "Choix du dossier") = vbNo Then Exit Sub
 
    With Application.FileDialog(4)
        If .Show = -1 Then Dossier = .SelectedItems(1)
    End With
 
    If Dossier = "" Then Exit Sub
 
    Dossier = Dossier & "\"
 
    'appel de la fonction...
    Tbl() = RecupFichiers(Dossier)
 
    'si le tableau a été initialisé...
    If Not Not Tbl Then
 
        Existe = True
        ListBox1.list = Tbl()
 
    End If
 
End Sub
 
Private Sub ListBox1_Click()
 
    Dim Cat As Object
    Dim Tbl() As String
 
    If Existe = False Then Exit Sub
 
    'crée l'objet catalogue
    Set Cat = CreateObject("ADOX.Catalog")
 
    Cat.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                           Dossier & ListBox1.Text & _
                           ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=2;"""
 
    'récupère les noms des feuilles
    Tbl = FeuillesExcel(Cat)
 
    'rempli la liste
    ListBox2.list = Tbl()
 
 
End Sub
 
Private Sub ListBox2_Click()
 
    MsgBox "En attendant plus d'explications, la feuille sélectionnée est : " & ListBox1.Text
 
End Sub
 
 
 
Function RecupFichiers(Chemin As String) As String()
 
    Dim TblFichiers() As String
    Dim Fichier As String
    Dim I As Integer
 
    Fichier = Dir(Chemin & "*.xls*") 'si seuls les.xlsx sont voulus,mettre "*.xlsx"
 
    Do While (Len(Fichier) > 0)
 
        I = I + 1: ReDim Preserve TblFichiers(1 To I)
        TblFichiers(I) = Fichier
 
        Fichier = Dir()
 
    Loop
 
    RecupFichiers = TblFichiers()
 
End Function
 
Public Function FeuillesExcel(Cat As Object) As String()
 
    Dim Tbl As Object
    Dim TblFeuilles() As String
    Dim I As Integer
 
    'crée l'objet table
    Set Tbl = CreateObject("ADOX.Table")
 
    'passe les feuilles en revue et récupère leurs nom sans le dollar
    'dans un tableau
    For Each Tbl In Cat.Tables
 
        I = I + 1: ReDim Preserve TblFeuilles(1 To I)
        TblFeuilles(I) = Replace(Tbl.Name, "$", "")
 
    Next
 
    'passe à la fonction
    FeuillesExcel = TblFeuilles
 
    Set Tbl = Nothing
 
End Function

Bon début de semaine