XL 2010 [RESOLU] Récupérer nom fichiers selon extension

cathodique · 15 Mai 2021

Bonjour,

Je voudrais récupérer dans la Listbox les fichiers dont l'extension est: *.bas - *.txt - *.cls - *.frm

VB:

Private Sub UserForm_Initialize()
    repertoire = ThisWorkbook.Path & "\1MesMacros\"
    MyFile = Dir(repertoire & "*.*")
    Do While MyFile <> ""
    If Mid(MyFile, InStrRev(MyFile, ".") + 1) = "bas" Or Mid(MyFile, InStrRev(MyFile, ".") + 1) = "txt" _
    Or Mid(MyFile, InStrRev(MyFile, ".") + 1) = "cls" Or Mid(MyFile, InStrRev(MyFile, ".") + 1) = "frm" Then
       
        ListBox1.AddItem MyFile
        End If
        MyFile = Dir
    Loop
End Sub

Dans le fichier ci-joint, j'arrive à récupérer pour une seule extension. J'avoue que je suis un peu perdu.

Avec mes remerciements anticipés.

edit: Merci beaucoup. Je suis parvenu à résoudre mon problème. Code mis à jour.

sylvanu · 15 Mai 2021

Bonjour Cathodique,
Ou en passant par un split :

VB:

Private Sub UserForm_Initialize()
    Dim T, Ex$
    repertoire = ThisWorkbook.Path & "\1MesMacros\"
    MyFile = Dir(repertoire)
    ListBox1.Clear
    Do While MyFile <> ""
        T = Split(MyFile, "."): Ex = T(UBound(T))
        If Ex = "bas" Or Ex = "txt" Or Ex = "cls" Or Ex = "frm" Then
            ListBox1.AddItem MyFile
        End If
        MyFile = Dir
    Loop
End Sub

sylvanu · 15 Mai 2021

Bonjour Cathodique,
Ou en passant par un split :

VB:

Private Sub UserForm_Initialize()
    Dim T, Ex$
    repertoire = ThisWorkbook.Path & "\1MesMacros\"
    MyFile = Dir(repertoire)
    ListBox1.Clear
    Do While MyFile <> ""
        T = Split(MyFile, "."): Ex = T(UBound(T))
        If Ex = "bas" Or Ex = "txt" Or Ex = "cls" Or Ex = "frm" Then
            ListBox1.AddItem MyFile
        End If
        MyFile = Dir
    Loop
End Sub

cathodique · 15 Mai 2021

sylvanu à dit:

Bonjour Cathodique,
Ou en passant par un split :

VB:

Private Sub UserForm_Initialize()
    Dim T, Ex$
    repertoire = ThisWorkbook.Path & "\1MesMacros\"
    MyFile = Dir(repertoire)
    ListBox1.Clear
    Do While MyFile <> ""
        T = Split(MyFile, "."): Ex = T(UBound(T))
        If Ex = "bas" Or Ex = "txt" Or Ex = "cls" Or Ex = "frm" Then
            ListBox1.AddItem MyFile
        End If
        MyFile = Dir
    Loop
End Sub

Bonsoir Sylvanu,

Très sympa de ta part. En effet, ça fonctionne très bien.
Merci beaucoup.
Bonne soirée.

edit: Résolu

job75 · 15 Mai 2021

Bonsoir cathodique, sylvanu,

Le code de l'USF :

VB:

Dim chemin$, liste$() 'mémorise les variables

Private Sub UserForm_Initialize()
Dim fichier$, n&
chemin = ThisWorkbook.Path & "\1MesMacros\"
fichier = Dir(chemin)
ReDim liste(0)
While fichier <> ""
    If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(fichier, 4) & "/") Then
        ReDim Preserve liste(n)
        liste(n) = fichier
        n = n + 1
    End If
    fichier = Dir
Wend
If n Then ListBox1.List = liste Else ListBox1.Clear
End Sub

Private Sub TextBox1_Change()
If liste(0) = "" Then Exit Sub
Dim critere$, i&, a$(), n&
critere = "*" & LCase(Trim(TextBox1)) & "*"
For i = 0 To UBound(liste)
    If LCase(liste(i)) Like critere Then
        ReDim Preserve a(n)
        a(n) = liste(i)
        n = n + 1
    End If
Next
If n Then ListBox1.List = a Else ListBox1.Clear
End Sub

A+

cathodique · 15 Mai 2021

job75 à dit:

Bonsoir cathodique, sylvanu,

Le code de l'USF :

VB:

Dim chemin$, liste$() 'mémorise les variables

Private Sub UserForm_Initialize()
Dim fichier$, n&
chemin = ThisWorkbook.Path & "\1MesMacros\"
fichier = Dir(chemin)
ReDim liste(0)
While fichier <> ""
    If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(fichier, 4) & "/") Then
        ReDim Preserve liste(n)
        liste(n) = fichier
        n = n + 1
    End If
    fichier = Dir
Wend
If n Then ListBox1.List = liste Else ListBox1.Clear
End Sub

Private Sub TextBox1_Change()
If liste(0) = "" Then Exit Sub
Dim critere$, i&, a$(), n&
critere = "*" & LCase(Trim(TextBox1)) & "*"
For i = 0 To UBound(liste)
    If LCase(liste(i)) Like critere Then
        ReDim Preserve a(n)
        a(n) = liste(i)
        n = n + 1
    End If
Next
If n Then ListBox1.List = a Else ListBox1.Clear
End Sub

A+

Bonsoir Job75 ,

Comme à l'accoutumé c'est parfait.
J'ai ouvert cette discussion pour parfaire mon idée de faire une bibliothèque avec ma petite collection de macros.
J'exposerai mon idée dans une prochaine discussion.

En tout cas merci beaucoup pour ton aide.

Bonne soirée.

cathodique · 16 Mai 2021

job75 à dit:

Bonsoir cathodique, sylvanu,

Le code de l'USF :

VB:

Dim chemin$, liste$() 'mémorise les variables

Private Sub UserForm_Initialize()
Dim fichier$, n&
chemin = ThisWorkbook.Path & "\1MesMacros\"
fichier = Dir(chemin)
ReDim liste(0)
While fichier <> ""
    If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(fichier, 4) & "/") Then
        ReDim Preserve liste(n)
        liste(n) = fichier
        n = n + 1
    End If
    fichier = Dir
Wend
If n Then ListBox1.List = liste Else ListBox1.Clear
End Sub

Private Sub TextBox1_Change()
If liste(0) = "" Then Exit Sub
Dim critere$, i&, a$(), n&
critere = "*" & LCase(Trim(TextBox1)) & "*"
For i = 0 To UBound(liste)
    If LCase(liste(i)) Like critere Then
        ReDim Preserve a(n)
        a(n) = liste(i)
        n = n + 1
    End If
Next
If n Then ListBox1.List = a Else ListBox1.Clear
End Sub

A+

Bonjour Sylvanu , Job75,

@job75 : Je te remercie pour ton code. Cependant, le filtrage de la listbox via la textbox n'est pas bon. Des fichiers sont manquants (image)

Le résultat du formulaire du bas (Userform1) est obtenu avec ce code

VB:

Private Sub TextBox1_Change()'à ameliorer peut-etre?'
    Dim liste
    ListBox2.Clear
    liste = Filter(Tb, TextBox1.Text, True, vbTextCompare)
    If UBound(liste) <> 0 Then
        ListBox1.List = liste
    Else
        ListBox1.Clear
    End If
End Sub

Bon dimanche.

job75 · 16 Mai 2021

Bonjour cathodique, le forum,

Mon code va très bien mais il ne faut pas le modifier sans comprendre.

Pour que la casse soit ignorée il ne faut pas oublier les 2 LCase dans la 2ème macro.

A+

cathodique · 16 Mai 2021

job75 à dit:
Bonjour cathodique, le forum,

Mon code va très bien mais il ne faut pas le modifier sans comprendre.

Pour que la casse soit ignorée il ne faut pas oublier les 2 LCase dans la 2ème macro.

A+

Merci beaucoup Job75,

Je n'ai rien modifié à ton code. J'ai d'ailleurs créé 2 formulaires exprès pour comparer les résultats.
Dans mon répertoire j'ai bien des fichiers qui commencent par "text" (texte taper dans la textbox).
Or, ces fichiers ne figurent pas dans la listbox (image post#6).
Ce n'est qu'une constatation.

Encore merci.

Bon dimanche.

edit: Commençant bien tes compétences, j'ai douté de ma manipulation. Je viens de créer un formulaire et y aie mis ton code. Je suis vraiment confus. Là, j'ai le résultat escompté.
J'avoue que j'ai gaffé. 1000 excuses.

XL 2010 [RESOLU] Récupérer nom fichiers selon extension

cathodique

XLDnaute Barbatruc

Pièces jointes

sylvanu

sylvanu

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

Discussions similaires