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

cathodique

XLDnaute Barbatruc
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.
 

Pièces jointes

  • AlimenterListBoxFichiersExtention.xlsm
    18.3 KB · Affichages: 18
Dernière édition:
Solution
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

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Barbatruc
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
 
Dernière édition:

job75

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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:cool:.
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

XLDnaute Barbatruc
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)
1621146232099.png

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.
 

cathodique

XLDnaute Barbatruc
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:eek:o_O. Là, j'ai le résultat escompté:cool:.
J'avoue que j'ai gaffé. 1000 excuses.
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
315 127
Messages
2 116 495
Membres
112 765
dernier inscrit
SIDIANW