Discussion :

[Bzh_novice]

Bonjour,

J'aimerai trouver une macro qui me permette de lister tous les dossiers dans un dossier, et ne pas tenir compte des sous dossiers.
Je souhaiterai juste avoir le nom du dossier et non pas son chemin d'accès.

J'ai trouvé plein d'exemple mais il y avais l'arborescence avec les sous dossiers et les fichier dans les dossiers et sous dossiers..

[SfJ5Rpw8]

Bonjour,

voir la commande DIR

[Bzh_novice]

Bonjour,

Merci Bbil grâce à ton aide j'ai progressé:
la liste de mes dossiers est réalisée.
Cependant je dois mettre dans mon programme le dossier de recherche ici est C:\
Seulement j'aimerai avoir une boite de dialogue me permettant d'aller chercher via explorateur
Si je mets un autre dossier que c:\ çà ne marche plus, pouvez vous me dire mon erreur?

Voici le code adapté de l'aide de DIR dont j'ai rajouté certaines lignes:

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
Sub Liste_Dossiers_dans_un_dossier()
 
Dim i As Integer
 
MyPath = "c:\"    ' Définit le chemin d'accès.
MyName = Dir(MyPath, vbDirectory)    ' Extrait la première entrée.
 
i = 1
 
Do While MyName <> ""    ' Commence la boucle.
 
    ' Ignore le dossier courant et le dossier
    ' contenant le dossier courant.
    If MyName <> "." And MyName <> ".." Then
 
        ' Utilise une comparaison au niveau du bit pour
        ' vérifier que MyName est un dossier.
        If (GetAttr(MyPath & MyName) _
            And vbDirectory) = vbDirectory Then
            Debug.Print MyName
 
       'Colle le nombre de dossiers dans la 1ère colonne à la ligne 6 pour commencer
        Cells(5 + i, 1) = i
        'Mets une bordure à la cellule
        Cells(5 + i, 1).Borders.Value = 1
 
        'Colle le 1er nom du dossier dans la 2ème colonne à la ligne 6 pour commencer
        Cells(5 + i, 2) = MyName
        'mets une bordure a la cellule
        Cells(5 + i, 2).Borders.Value = 1
 
        i = i + 1
 
        End If
 
    End If
    MyName = Dir
Loop
 
End Sub

[Bzh_novice]

Voici un code que j'ai trouvé qui marche , seulement j'aurai aimé avoir une boite de dialogue qui ouvre l'explorateur pour trouver mon chemin d'accès

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
Private Sub CommandButton2_Click()
'Permet de fournir la liste des dossiers dans un dossier
 
Dim a As String, b As String, i As Integer
 
a = InputBox("Collez ici l'adresse du dossier considéré")
 
b = InputBox("Voulez vous le lien hypertexte", "Disponible uniquement sur PC", "NON")
 
If a = "" Then
Exit Sub
End If
 
i = 1
 
Dim fs, f, f1, s, sf
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(a)
Set sf = f.SubFolders
 
 
    For Each f1 In sf
        s = f1.Name
        Sheets("Feuil1").Select
 
        'Ecriture en dessous de la ligne 6
        Cells(6 + i, 2).Select
        Cells(6 + i, 2).Borders.Value = 1
        Cells(6 + i, 1) = i
        Cells(6 + i, 1).Borders.Value = 1
        ActiveCell.FormulaR1C1 = s
 
        'MsgBox (a & "\" & s)
        If b = "oui" Then
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=a & "\" & s, _
        TextToDisplay:=s
        End If
 
   i = i + 1
   Next
 
Exit Sub
 
End Sub

[SfJ5Rpw8]

J'aurais bien voulu voir ce qui ne marché pas avec DIR ... , comment avait tu implémenté ce changement de répertoire...


pour sélectionner le répertoire de base voir par :



http://excel.developpez.com/faq/?pag...cel#FileDialog

[Bzh_novice]

Re bonjour

Alors le 1er code ne marchait pas j'avais fais 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
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
Sub Liste_Dossiers_dans_un_dossier()
 
Dim i As Integer
 
'Boite de dialogue ouvrant explorateur
With Application.FileDialog(msoFileDialogFolderPicker)
    'Définit un titre pour la boîte de dialogue
    .Title = "Choisissez votre dossier source:"
    'Affiche la boîte de dialogue
    .Show
 
    'Affiche le nom du dossier sélectionné
    If .SelectedItems.Count > 0 Then
    MsgBox .SelectedItems(1)
    Mypath = .SelectedItems(1)
 
    End If
 
End With
 
MyName = Dir(Mypath, vbDirectory)    ' Extrait la première entrée.
 
i = 1
 
Do While MyName <> ""    ' Commence la boucle.
 
    ' Ignore le dossier courant et le dossier
    ' contenant le dossier courant.
    If MyName <> "." And MyName <> ".." Then
 
        ' Utilise une comparaison au niveau du bit pour
        ' vérifier que MyName est un dossier.
        If (GetAttr(Mypath & MyName) _
            And vbDirectory) = vbDirectory Then
            Debug.Print MyName
 
       'Colle le nombre de dossiers dans la 1ère colonne à la ligne 6 pour commencer
        Cells(5 + i, 1) = i
        'Mets une bordure à la cellule
        Cells(5 + i, 1).Borders.Value = 1
 
        'Colle le 1er nom du dossier dans la 2ème colonne à la ligne 6 pour commencer
        Cells(5 + i, 2) = MyName
        'mets une bordure a la cellule
        Cells(5 + i, 2).Borders.Value = 1
 
        i = i + 1
 
        End If
 
    End If
    MyName = Dir
Loop
 
End Sub

ca bug au niveau de :

Code :

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

1
2
        If (GetAttr(Mypath & MyName) _
            And vbDirectory) = vbDirectory Then