XL 2010 Dresser un Array recensant les différentes extensions des fichiers d’un dossier

Magic_Doctor

XLDnaute Barbatruc
Bonsoir,

Je récupère la liste de tous les fichiers contenus dans un dossier. Il y a des fichiers de tous types : .pdf, .doc, .txt, .mp3, .avi…
Forcément, pour chaque type de fichier, il y en a, au minimum, un ou plusieurs, Je voudrais dresser un Array recensant toutes les extensions des fichiers que l’on peut trouver dans un dossier. Si dans ce dossier il y a, par exemple, 25 fichiers pdf, 250 fichiers mp3 et 33 fichiers txt, alors l’Array contiendra 3 items : .pdf, .mp3, .txt. Autrement dit, les 3 types de fichiers que l’on peut trouver dans le dossier.

Comment s’y prendre ?
 
Bonsoir Magic_doctor, Marcel32, le forum

Une proposition

Cordialement, @+
VB:
Sub Extraire_Extensions()
    Dim Chemin_Dir$, Objet1 As Object, Objet2 As Object, Array_Extensions, Fich_Ext$
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Choisir"
        .AllowMultiSelect = False
        .Title = "Choisissez le dossier à examiner"
        .Show
        If .SelectedItems.Count > 0 Then
            Chemin_Dir = .SelectedItems(1)
        Else
            MsgBox "pas de dossier sélectionné" & vbLf & "Abandon de la notification", vbOKOnly + vbInformation, "Information"
            Exit Sub
        End If
    End With
    Set Objet1 = CreateObject("Scripting.FileSystemObject")
    Set Objet2 = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin_Dir)
    For Each Objet1 In Objet2.Files
        If InStrRev(Objet1.Name, ".") Then
            Fich_Ext = Mid(Objet1.Name, InStrRev(Objet1.Name, "."))
            If InStr(1, Array_Extensions, Fich_Ext) = 0 Then Array_Extensions = IIf(Array_Extensions = "", Fich_Ext, Array_Extensions & "|" & Fich_Ext)
        End If
    Next Objet1
    Array_Extensions = Split(Array_Extensions, "|")
    MsgBox "Liste des " & UBound(Array_Extensions) - LBound(Array_Extensions) + 1 & " extensions du dossier : " & Chemin_Dir & vbLf & Join(Array_Extensions, vbLf), vbOKOnly + vbInformation
End Sub
 
Dernière édition:

Magic_Doctor

XLDnaute Barbatruc
Re,

J'ai réussi à résoudre le problème.
Je pense que l'on peut faire plus simple. En attendant, le problème n'est pas piqué des vers.
1/ identifier toutes les extensions
2/ dresser un array avec toutes les extensions
3/ supprimer tous les doublons de l'array
4/ trier les items de l'array par ordre alphabétique qui seront finalement récupérés dans un ComboBox
Pour ce faire, j'ai eu recours à 2 fonctions et une macro.
Les fonctions :
VB:
Public Function GetFileExtension(fichier As String) As String
'Renvoie l'extension d'un fichier
'- fichier : le nom ad integrum du fichier (ex : "La vie ténébreuse de Mère Térésa.pdf") --> .pdf

    GetFileExtension = Right(fichier, Len(fichier) - (InStrRev(fichier, ".") - 1))
End Function
VB:
Function RemoveDupesColl(MyArray As Variant) As Variant
'DESCRIPTION: Removes duplicates from your array using the collection method.
'NOTES: (1) This function returns unique elements in your array, but it converts your array elements to strings.
'SOURCE: https://wellsr.com/vba/2017/excel/vba-remove-duplicates-from-array/#:~:text=The%20RemoveDupesColl%20removes%20duplicate%20entries,to%20an%20array%20of%20strings.
'-----------------------------------------------------------------------
    Dim i As Long
    Dim arrColl As New Collection
    Dim arrDummy() As Variant
    Dim arrDummy1() As Variant
    Dim item As Variant
    ReDim arrDummy1(LBound(MyArray) To UBound(MyArray))

    For i = LBound(MyArray) To UBound(MyArray) 'convert to string
        arrDummy1(i) = CStr(MyArray(i))
    Next
    On Error Resume Next
    For Each item In arrDummy1
       arrColl.Add item, item
    Next item
    Err.Clear
    ReDim arrDummy(LBound(MyArray) To arrColl.Count + LBound(MyArray) - 1)
    i = LBound(MyArray)
    For Each item In arrColl
       arrDummy(i) = item
       i = i + 1
    Next
    RemoveDupesColl = arrDummy
End Function
La macro :
VB:
Sub Tri(a, gauc, droi) 'Quick sort
'BOISGONTIER

    Dim ref, g, d, temp
    
    ref = a((gauc + droi) \ 2)
    g = gauc: d = droi
    Do
        Do While a(g) < ref: g = g + 1: Loop
        Do While ref < a(d): d = d - 1: Loop
        If g <= d Then
            temp = a(g): a(g) = a(d): a(d) = temp
            g = g + 1: d = d - 1
        End If
    Loop While g <= d
    If g < droi Then Call Tri(a, g, droi)
    If gauc < d Then Call Tri(a, gauc, d)
End Sub
Ma procédure :
VB:
Sub ListeFichiers(Repertoire As String)
'Affiche la liste de tous les fichiers contenus dans "Repertoire" (Dossier unique ou Dossier + Sous-Dossiers)
'SilkyRoad (https://excel.developpez.com/faq/?page=FichiersDir#ListeFichiersScriptingRuntime)
'Magic_Doctor
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils / Références --> Cochez la ligne "Microsoft Scripting RunTime"
 
    Dim Fso As Scripting.FileSystemObject, SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder, FileItem As Scripting.File
    Dim i As Long, nbFichiers As Long, ext$, extAV%, TailleFichier, TotalTaillesFichiers, secondes#, TotalSecondes#
    Dim j As Byte, fichiersAV, fichiersSup, extOut$
    Dim ArrayExt(), k, ArrayExtSansDoublons()
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    i = Hoja1.Range("A" & Rows.Count).End(xlUp).Row + FirstLigne  'récupèration du numéro de la dernière ligne vide dans la colonne A
    fichiersAV = Array(".avi", ".wav", ".mp3", ".mp4")            'formats reconnus par la fonction "GetVideoDuration"
    fichiersSup = Array(".ini", ".crdownload", ".m4a", ".pdgcp", ".m3u", ".avif", ".img", ".htm") 'formats indésirables
    
    On Error Resume Next
    
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        ext = GetFileExtension(FileItem.Name)  'extension du fichier
        
        For j = LBound(fichiersAV) To UBound(fichiersAV)   'on passe en revue tout l'array "fichiersAV"
            If ext = fichiersAV(j) Then extAV = extAV + 1  'décompte des fichiers Audio/Vidéo reconnus par la fonction "GetVideoDuration"
        Next
        For j = LBound(fichiersSup) To UBound(fichiersSup) 'on passe en revue tout l'array "fichiersSup"
            If ext = fichiersSup(j) Then extOut = fichiersSup(j)
        Next
        
        If Left(FileItem.Name, 2) = "~$" Or Left(FileItem.Name, 8) = "AlbumArt" Or FileItem.Name = "Folder.jpg" Or FileItem.Name = "Thumbs.db" Or ext = extOut Then GoTo fin 'élimination des fichiers indésirables

        k = k + 1
        ReDim Preserve ArrayExt(k)
        ArrayExt(k) = ext 'on dresse l'Array "ArrayExt" avec toutes les extensions des différents fichiers
        
        Cells(i, 1) = i - FirstLigne                                                                          'numéro d'ordre du fichier
        Cells(i, 2) = FileItem.Name                                                                           'nom du fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 2), Address:=FileItem.ParentFolder & "\" & FileItem.Name  'ajoute un lien hypertexte vers le fichier
        Cells(i, 3) = ext  'occulté dans la feuille (tri)

        TailleFichier = FileLen(FileItem)
        Cells(i, 4) = TailleFichier  'taille du fichier en bytes (occulté dans la feuille : tri)
        TotalTaillesFichiers = TotalTaillesFichiers + TailleFichier  'taille de l'ensemble des fichiers en bytes
        
        Cells(i, 5) = BytesEnTGMK(TailleFichier) 'conversion des bytes en Kb, Mb, Gb ou Tb pour la taille du fichier
        
        If Evaluate("Remember_VoirDuration") = True Then                          'récupération de la durée des fichiers Audio/Vidéo
            If ext = ".avi" Or ext = ".wav" Or ext = ".mp3" Or ext = ".mp4" Then  'formats reconnus par la fonction "GetVideoDuration"
                secondes = GetVideoDuration(Repertoire & "\" & FileItem.Name)
                TotalSecondes = TotalSecondes + secondes                          'nombre total de secondes de TOUS les fichiers
                Cells(i, 6) = Format(secondes / 86400, "hh:mm:ss")                'durée du fichier Audio/Vidéo
            End If
        End If
        
        i = i + 1 'nombre de fichiers
fin:
    Next
    
    ArrayExtSansDoublons = RemoveDupesColl(ArrayExt)          'élimination des doublons contenus dans l'Array "ArrayExt"
    Tri ArrayExtSansDoublons, 0, UBound(ArrayExtSansDoublons) 'tri l'Array "ArrayExtSansDoublons" par ordre alphabétique
    Sheets("Hoja1").ComboBoxExt.List = ArrayExtSansDoublons   'dresse la liste du Combobox "ComboBoxExt"
    
    ...
    
End Sub
 

TooFatBoy

XLDnaute Barbatruc
🥸
Une proposition en pièce jointe.



Remarque : je pense que la colonne E de ta feuille affiche des choses doublement fausses. :(
1- 4 331 056 qui devient 4,13... c'est pô bon ! 😁
2- Je doute que ce soit des bits. A mon avis, ce sont plutôt des octets. ;)
 

Pièces jointes

  • Tri.xlsx
    104.7 KB · Affichages: 11
Dernière édition:

Magic_Doctor

XLDnaute Barbatruc
Re,

Je n'ai pas l'impression de m'être planté.
TailleFichier = FileLen(FileItem)
Le résultat est en bytes. Je veux convertir, suivant la taille, ce résultat soit en Tb, soit en Gb, soit en Mb, soit en Kb.
En m'inspirant de trucs comme celui.ci, j'ai rédigé cette fonction :
VB:
Function BytesEnTGMK(taille) As String
'Converti des Bytes en Tb, Gb, Mb ou Kb
'Magic_Doctor

    If taille >= 10 ^ 12 Then
        BytesEnTGMK = NombreEnTxt(taille / 1024 ^ 4, 2, "") & " Tb"
    ElseIf taille >= 10 ^ 9 Then
        BytesEnTGMK = NombreEnTxt(taille / 1024 ^ 3, 2, "") & " Gb"
    ElseIf taille >= 10 ^ 6 Then
        BytesEnTGMK = NombreEnTxt(taille / 1024 ^ 2, 2, "") & " Mb"
    Else
        BytesEnTGMK = NombreEnTxt(taille / 1024, 2, "") & " Kb"
    End If
End Function
NombreEnTxt est une autre fonction que j'aime bien, elle permet de présenter des nombres d'une manière plus élégante, par exemple : 3,4 --> 3,40. Ainsi, tous les chiffres de la colonne ont toujours 2 chiffres après la virgule. C'est plus joli...
VB:
Function NombreEnTxt$(num As Variant, x As Byte, TypeSep$, Optional mas As Boolean = False)
'Retranscrit un nombre en chaîne.
'Complète s'il le faut, avec des 0, un nombre décimal, de telle sorte qu'il y ait un nombre déterminé de chiffres après la virgule.
'Place éventuellement des séparateurs de milliers
'job75 / Magic_Doctor
'************************************************************************************************************************************
'- num     : un nombre
'- x       : le nombre de chiffres voulu après la virgule
'- TypeSep : si ""  --> pas de séparateurs de milliers (25145785 --> 25145785)
'            si " " --> espace (25145785 --> 25 145 785)
'            si "." --> point  (25145785 --> 25.145.785)
'- mas     : si True : si le nombre est positif, alors il sera précédé du signe "+"
'Exemple   : si x = 2 & sep = True ou omis => num = 2               --> 2,00
'                                             num = 125752,22       --> 125.752,22
'                                             num = -202454524565,5 --> -202.454.524.565,50
'            si x = 5 | sep = True | TypeSep = " " | mas = True => num = 125365875,25 --> +125 365 875,25000
'************************************************************************************************************************************

    Dim signe$, Txt$, i%, t$, n$, nb$, pos As Byte, gauche$, droite$, millier$

    On Error Resume Next 'pour que n'apparaisse pas #¡VALOR! si num = ""
    If num = "" Then Exit Function
    
    signe = IIf(num = Abs(num), IIf(mas, "+", ""), "-")
    
    num = FormatNumber(num, 15) 'pour éviter que ne s'impose la notation scientifique
    Txt = CStr(Abs(num))
    For i = 1 To Len(Txt)
        t = Mid(Txt, i, 1)
        If Not IsNumeric(t) And t <> "," And t <> "." Then Exit For
    Next
    t = Replace(Left(Txt, i - 1), ",", ".")
    n = IIf(i = 1, "", Format(Val(t), "0." & String(x, "0")))
    If x = 0 Then n = Replace(n, ",", "") 'pas de décimale après la virgule donc pas de virgule
    
    nb = n & Mid(Txt, i)
    pos = InStr(1, nb, ",")
    gauche = Left(nb, pos - 1)
    droite = Mid(nb, pos + 1)
    
    If TypeSep = "" Then  'pas de séparateurs de milliers
        NombreEnTxt = signe & n
    Else  'séparateurs de milliers (" " ou ".")
        If x = 0 Then  'nombre entier
            millier = IIf(TypeSep = " ", Replace(Format(Int(Abs(num)), "#,##0"), ".", Chr(160)), Replace(Format(Int(Abs(num)), "#,##0"), Chr(160), "."))
            NombreEnTxt = signe & millier
        Else  'nombre décimal
            millier = IIf(TypeSep = " ", Replace(Format(CDec(gauche), "#,##0"), ".", Chr(160)), Replace(Format(CDec(gauche), "#,##0"), Chr(160), "."))
            If InStr(gauche, Application.DecimalSeparator) Then millier = millier & Mid(gauche, InStr(gauche, Application.DecimalSeparator))
            NombreEnTxt = signe & millier & "," & droite
        End If
    End If
End Function
Je prends au hasard un fichier et consulte ses propriétés (bouton droit souris) :
Weather Report - China Blues.mp3
Taille : 5,66 Mb (5 943 619 bytes)
Sur la feuille : 5 943 619 bytes | 5,67 Mb
Ma foi, ça a l'air de concorder.

Récupérer les extensions de tous les fichiers, avec la fonction GetFileExtension (post #4), c'est nettement plus commode qu'avec des formules qui, quand on ne les a pas écrites, deviennent rapidement incompréhensibles. Du reste, je n'utilise pratiquement jamais des formules sur mes feuilles, je préfère définitivement VBA. Question de choix personnel pour Excel.
Enfin, récupérer dans un ComboBox toutes les extensions de fichiers pouvant se trouver dans un dossier me paraît duraille, en tout cas hors de mes compétences de formulateur. Alors je le fais en VBA.
Quoi qu'il en soit, voici ce que j'obtiens à partir d'un autre dossier avec 1051 fichiers de toutes sortes :

Ma Liste.jpg
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour MagicDoctor, Bernard, Marcel,
Tant qu'à faire, une autre proposition:
Code:
Sub BoucleFichiers()
    On Error GoTo Fin
    Dim Chemin$, Fichier$, Ligne%, T, DL%, TableauExtensions, T0
    T0 = Timer
    [A:D].ClearContents
    Application.ScreenUpdating = False
    Sheets.Add(after:=Sheets(Worksheets.Count)).Name = "OnBosse"
    Sheets("OnBosse").Select
    Chemin = "g:\Users\PC_PAPA\Documents"                                   ' A ADAPTER
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"   ' Pour les étourdis.
    Ligne = 1
    ' Liste les fichiers
    Fichier = Dir(Chemin & "*.*")
    Do While Len(Fichier) > 0
        Cells(Ligne, "A") = Fichier
        Ligne = Ligne + 1
        Fichier = Dir()
    Loop
    ' Extrait les extensions
    For i = 1 To Range("A65500").End(xlUp).Row
        T = Split(Cells(i, "A"), "."): Cells(i, "B") = T(UBound(T))
    Next i
    DL = Range("B65500").End(xlUp).Row
    Range("C1:C" & DL) = Range("B1:B" & DL).Value
    Range("C1:C" & DL).RemoveDuplicates Columns:=1, Header:=xlNo
    DL = Range("C65500").End(xlUp).Row
    Range("D1:D" & DL).FormulaLocal = "=NB.SI(B:B;C1)"
    Range("D1:D" & DL) = Range("D1:D" & DL).Value
    TableauExtensions = Range("C1:D" & DL)
    Application.DisplayAlerts = False
    Sheets("OnBosse").Delete
    Application.DisplayAlerts = True
    
    '------------------------------------------------------------------------------------------
    ' JUSTE POUR LA DEMO, A SUPPRIMER
    [C:F].ClearContents
    [C5] = "Les données sont dans l'array TableauExtensions"
    [C7] = "Temps d'exécution = " & Round(1000 * (Timer - T0), 0) & " ms"
    [C9].Resize(UBound(TableauExtensions, 1), UBound(TableauExtensions, 2)) = TableauExtensions
    '------------------------------------------------------------------------------------------
Fin:
End Sub
On met à jour le Chemin.
Le résultat est dans l'array TableauExtensions.
Résultat :
1655620861672.png
 

Pièces jointes

  • EssaiListeExtensions.xlsm
    19.7 KB · Affichages: 9

Efgé

XLDnaute Barbatruc
Bonjour à tous
Pour répondre strictement à la question ;
VB:
Sub Extensions()
Dim Fichier$, Bur$
Dim Dico As Object
Dim TReport As Variant, Text As Variant

'Dossier listé : Bureau
Bur = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "/"
Set Dico = CreateObject("scripting.dictionary")

Fichier = Dir(Bur & "*.*")
Do While Len(Fichier) > 0
    Text = Split(Fichier, ".")
    Dico("." & Text(UBound(Text))) = ""
    Fichier = Dir()
Loop
TReport = Application.Transpose(Dico.keys)
End Sub

Ce qui donne un tableau à deux dimentions (1 to Nombre de clés du dictionnaire, 1 to 1)
Cordialement
 
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
Je n'ai pas l'impression de m'être planté.
TailleFichier = FileLen(FileItem)
Le résultat est en bytes. Je veux convertir, suivant la taille, ce résultat soit en Tb, soit en Gb, soit en Mb, soit en Kb.
En m'inspirant de trucs comme celui.ci, j'ai rédigé cette fonction :
L'idée d'une fonction pour changer le préfixe de l'unité de mesure est vraiment excellente. 👍

Mais il y a tout de même ces deux petits problèmes dont je parlais, plus un troisième que je n'avais pas voulu aborder et qui sera en fait le plus simple à résoudre.



Je commence par le plus simple : l'abréviation de "kilo" est "k" et non "K". 😉



Je continu par de deuxième point abordé en #5.
Tu dis que la taille des fichiers est exprimée en "bytes", mais tu affiches "b" qui est l'abréviation de "bit".
L'abréviation de "byte" étant quant à elle "B".

Donc, si la taille des fichiers est donnée en "bytes" de 1 bit, alors dans ce cas c'est bon, c'est pareil, 1 MB = 1 Mb.
Mais généralement la taille des fichiers est donnée en octets, donc en "bytes" de 8 bits, et du coup là ce n'est plus bon, puisque dans ce cas 1 MB = 8 Mb.

L'idéal est bien sûr d'utiliser l'octet, comme ça on ne se pose pas de question puisqu'un octet est toujours constitué de 8 bits : 1 o = 8 b.



Je termine par le premier point abordé en #5.
Le lien sur lequel tu t'es basé est faux.

Explication rapide : si tu utilises ko, Mo, Go, etc. il faut diviser par 10^3, 10^6, 10^9, etc. et non diviser par 1024, 1024^2, 1024^3, etc.
Autrement dit, 1 kilooctet = 1 ko = 1 000 octets.

Si tu divises par 1024, il faut alors utiliser les coefficients binaires.
Autrement dit, 1 kibioctet = 1 kio = 1024 octets.

Mais l'erreur étant la même dans les Windows, je suppose que tu vas volontairement la laisser dans ta fonction. 😉
 
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
NombreEnTxt est une autre fonction que j'aime bien, elle permet de présenter des nombres d'une manière plus élégante, par exemple : 3,4 --> 3,40. Ainsi, tous les chiffres de la colonne ont toujours 2 chiffres après la virgule. C'est plus joli...
Là tu t'embêtes pour rien avec ton usine à gaz... : tu dis simplement à Excel d'utiliser le format de nombres avec deux chiffres après la virgule et c'est bon, tu as ton affichage "3,40" au lieu de "3,4". ;)


Récupérer les extensions de tous les fichiers, avec la fonction GetFileExtension (post #4), c'est nettement plus commode qu'avec des formules qui, quand on ne les a pas écrites, deviennent rapidement incompréhensibles.
100 % d'accord avec toi !
D'ailleurs, moi-même je ne la comprends pas cette formule... Je l'ai empruntée je crois (c'était il y a bien longtemps) au fort regretté sieur Jacques BOISGONTIER.

Du reste, je n'utilise pratiquement jamais des formules sur mes feuilles, je préfère définitivement VBA. Question de choix personnel pour Excel.
Je te comprends.
Perso je préfère les formules quand c'est possible car les macros VBA sont généralement plus lentes.
Mais c'est vrai qu'ici le VBA convenir parfaitement. 👍

Enfin, récupérer dans un ComboBox toutes les extensions de fichiers pouvant se trouver dans un dossier me paraît duraille, en tout cas hors de mes compétences de formulateur. Alors je le fais en VBA.
C'est ce que fait le fichier que j'ai joint en #5. Mais la solution en VBA de notre modo adoré 😇 est absolument parfaite !
 
Dernière édition:
Bonjour le fil, le forum

C'est ce que fait le fichier que j'ai joint en #5. Mais la solution en VBA de notre modo adoré 😇 est absolument parfaite !
Et il me semble, si je ne me trompe, que la proposition du post#3 répondait exactement à la demande de cette discussion telle qu'elle était formulée.
Je récupère la liste de tous les fichiers contenus dans un dossier. Il y a des fichiers de tous types : .pdf, .doc, .txt, .mp3, .avi…
Forcément, pour chaque type de fichier, il y en a, au minimum, un ou plusieurs, Je voudrais dresser un Array recensant toutes les extensions des fichiers que l’on peut trouver dans un dossier. Si dans ce dossier il y a, par exemple, 25 fichiers pdf, 250 fichiers mp3 et 33 fichiers txt, alors l’Array contiendra 3 items : .pdf, .mp3, .txt. Autrement dit, les 3 types de fichiers que l’on peut trouver dans le dossier.

Bien cordialement, @+
 

fanch55

XLDnaute Barbatruc
Re,
Comme le dit @Efgé , si on doit répondre uniquement à la demande et retourner un array,
la fonction ci-dessous devrait suffire .
Depuis que j'ai eu plein de problèmes avec la fonction Dir dans Office 365,
je passe plutôt par le Fso ...
VB:
Function Get_Extensions(Dossier)
Dim Fichier     As Variant
Dim Tab_Save    As Variant
Dim Tab_Trié    As Variant
Dim Fso         As Object
Dim Dico        As Object
Dim I           As Long
Dim J           As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
        Set Dico = CreateObject("scripting.dictionary")
            For Each Fichier In Fso.GetFolder(Dossier).Files
                Dico(Fso.GetExtensionName(Fichier)) = vbNullString
            Next
           ' tri de la table
            Tab_Trié = Dico.keys
            For I = LBound(Tab_Trié) To UBound(Tab_Trié) - 1
                For J = I + 1 To UBound(Tab_Trié)
                    If Tab_Trié(I) > Tab_Trié(J) Then
                        Tab_Save = Tab_Trié(J)
                        Tab_Trié(J) = Tab_Trié(I)
                        Tab_Trié(I) = Tab_Save
                    End If
                Next J
            Next I
            Get_Extensions = Tab_Trié
        Set Dico = Nothing
    Set Fso = Nothing
End Function
 

soan

XLDnaute Barbatruc
Inactif
Bonjour fanch55, le fil,

dans ton code VBA, je vois que tu as fait un tri avec 2 boucles For ; j'trouve ça bizarre, car j'croyais qu'en mettant des données dans le dictionnaire, ça les triait automatiquement ; ou p't'être que j'me trompe ?​

soan
 

fanch55

XLDnaute Barbatruc
Bonjour fanch55, le fil,

dans ton code VBA, je vois que tu as fait un tri avec 2 boucles For ; j'trouve ça bizarre, car j'croyais qu'en mettant des données dans le dictionnaire, ça les triait automatiquement ; ou p't'être que j'me trompe ?​

soan
Salut @soan,
Un dictionnaire n'est jamais trié .
Mais on peut utiliser un arraylist :
VB:
Function Get_Extensions(Dossier)
Dim Fichier  As Variant, Ext   As Variant
Dim Fso      As Object, Dico   As Object
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Dico = CreateObject("System.Collections.ArrayList")
            For Each Fichier In Fso.GetFolder(Dossier).Files
                Ext = Fso.GetExtensionName(Fichier)
                If Not Dico.Contains(Ext) Then Dico.Add Ext
            Next
            Dico.Sort
            Get_Extensions = Dico.ToArray
        Set Dico = Nothing
    Set Fso = Nothing
End Function

Bonjour
Ces extentions dans le combobox
à l'initiasation en VBA les affecter au fur et à mesure puis il suffit d'attribuez à la propriété "Sorted" (du combobox) la valeur "true".
Et voilà un tri éviter dans le code vba :)
Salut @Deadpool_CC ,
la demande est d'obtenir un array, pas un combobox .
Mais je suis intrigué : je n'ai pas de propriété Sorted dans mes comboboxs ( excel 2019 )
 

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 769
Membres
101 816
dernier inscrit
Jfrcs