VBA - Excel [Résolu]

Signaler
Messages postés
10
Date d'inscription
dimanche 19 octobre 2008
Statut
Membre
Dernière intervention
21 octobre 2009
-
Messages postés
10
Date d'inscription
dimanche 19 octobre 2008
Statut
Membre
Dernière intervention
21 octobre 2009
-
Bonjour,

Je débute dans VBA sous excel.  Grâce au site, j'ai déjà pu créer une macro me permettant d'insérer les photos d'un dossier donné dans une feuille excel et, sous une certaine présentation.

J'aimerais maintent affiner l'utilisation de cette macro et la rendre plus conviviale par l'utilisation d'un userform qui me permettrait de choisir un utilisateur.  En fonction de cet utilisateur, je saurais dans quel répertoire je dois ensuite "travailler".  Le choix de l'utilisateur conditionnerait les valeurs qui apparaîtraient dans une combobox en-dessous.  Cette combobox devrait lister tous les sous-répertoires de l'utilisateur.  La sélection d'une valeur dans la combobox me permettrait alors de dédifinir le répertoire dans lequel je vais chercher les fichiers jpg à insérer dans ma feuille (cette dernière partie est ok).

Je pense que lister les fichiers d'un répertoire a déjà été expliqué.  Ce qu'il me faudrait, c'est comment lister les sous répertoires. Merci d'avance pour votre aide.

8 réponses

Messages postés
577
Date d'inscription
vendredi 26 septembre 2008
Statut
Membre
Dernière intervention
20 novembre 2010
4
Bonjour Rodavaflo & Co

Voici un programme VBA qui liste tous les sous_repertoires d'un repertoire "c:\...\utilisateur" dans une ListBox. Je l'ai dérivé d'une discussion en cours sur ce forum et traitant, à peu de choses près, du même sujet.

Sub lister_repertoires_utilisateur()
    Dim liste As String, ligne As Integer, chemin As String
    Dim userDir As String
    userDir = "c:\...\utilisateur"   ' à modifier
    recurseListeSousRep userDir, liste
    ligne = 1
    Do
        chemin = Left(liste, InStr(1, liste, ";"))
        liste = Replace(liste, chemin, "", 1, 1)
        chemin = Replace(chemin, userDir & "", "", 1, 1)
        Cells(ligne, 1).Value = Replace(chemin, ";", "", 1)
        ligne = ligne + 1
    Loop Until liste = ""
    ListBox.RowSource = "A1:A" & Trim(Str(ligne - 1))
End Sub



Sub recurseListeSousRep(rep As String, liste As String)
'
' liste récursivement les sous-repertoires du repertoire rep
'
    Dim fileSys             ' objet representant le systeme de fichiers
    Dim repertoireCourant   ' objet Folder representant le repertoire courant
    Dim sousRepertoires     ' objet Folders representant les sous-repertoires
    Dim sousRepertoire      ' objet Folder representant l'un des sous-repertoires
    Dim sep As String       ' separateur ("" pour Windows)
    Dim cible As String     ' chemin du fichier dans le repertoire courant
    Dim Erreur As Boolean
'    MsgBox liste
    sep = Application.PathSeparator
    Set fileSys = CreateObject("Scripting.fileSystemObject")
' creer un objet Folder representant le repertoire courant
    Set repertoireCourant = fileSys.getfolder(rep)
' creer une collection Folders representant les sous-repertoires
    Set sousRepertoires = repertoireCourant.subfolders
' balayer la collection en creant un objet Folder pour chaque sous-repertoire
    On Error GoTo erreurAccesRep
    Erreur = False
    For Each sousRepertoire In sousRepertoires
' recherche le fichier par iteration
        If Not Erreur Then
            liste = liste & rep & sep & sousRepertoire.Name & ";"
            recurseListeSousRep rep & sep & sousRepertoire.Name, liste
        End If
    Next
    On Error GoTo 0
    Exit Sub
erreurAccesRep:
    Erreur = True
    Resume Next
End Sub



Cordialement
Messages postés
682
Date d'inscription
vendredi 6 avril 2007
Statut
Membre
Dernière intervention
4 août 2012
6
bonjour
regardes dans l'aide  (F1)
Dir
il y a des exemples qui répondent exactement à ton probleme

[reglement.aspx ]si c'est la solution, penser : REPONSE ACCEPTEE
Messages postés
13
Date d'inscription
samedi 15 décembre 2007
Statut
Membre
Dernière intervention
24 juillet 2009

Bonjour, voici un exemple en .NET qui doit pouvoir être adapté en VBA

Dim TableauRepertoire(5) as String
    Dim NomDossier as String   
    Dim dossier As String
    For Each dossier In my.Computer.FileSystem.GetDirectories("C:\Users\**\Desktop\versions")
    TableauRepertoire = dossier.Split("")
    NomDossier = TableauRepertoire(5)
    If NomDossier.StartsWith("V") Then
        Cb_Version.Items.Add(NomDossier)
    End If
    Next
    Cb_Version.SelectedIndex = 0

Ce bout de code permet la récupération du sous répertoire. De garder uniquement son cinquième mot et de l'ajouter à la combobox si ce dernier commence par V.

En esperant avoir compris la question. ;);)
Messages postés
156
Date d'inscription
mardi 4 novembre 2003
Statut
Membre
Dernière intervention
28 décembre 2010

Hello Roda,

Je te passe une procedure que j'utilise sous VB pour lister les fichiers, les repertoires et les sous repertoires, je ne sais pas si ca marche sous VBA, mais je pense que ca doit etre pareille.

1. Tu copie cette procedure Comme elle est
Public Sub PROCEDURE_RECURSETREE(Current_Path As String, Use_Form As Form, ListBox_File As Object, Clear_ListBox As Boolean, Optional ListBox_Racine As Object, Optional Recup_UnderFolder As Boolean = False)
Dim Integer_N, Integer_Directory                                    As Integer
Dim String_FileName, String_DirectoryList()                         As String

DoEvents
If Clear_ListBox = True Then                                        'Reset les differentes Liste
    ListBox_File.Clear                                              'Reset la liste Fichier
    ListBox_Racine.Clear                                            'Reset la liste Racine
End If
String_FileName = Dir(Current_Path)
Do While String_FileName <> ""                                      'Tant que ce sont des fichiers
    String_Complete = Current_Path & String_FileName                'PathName dans la variable
    If String_FileName <> "" Then
        ListBox_Racine.AddItem (Current_Path)                       'Ajoute l'evenement
        ListBox_File.AddItem (String_FileName)                      'Ajoute l'evenement
    End If
    String_FileName = Dir
Loop
String_FileName = LCase(Dir(Current_Path, vbDirectory))             'Assigne le repertoire a analyser
Do While String_FileName <> ""                                      'Tant que la variable ne contient pas de fichier
    If String_FileName <> "." And String_FileName <> ".." And String_FileName <> "pagefile.sys" Then
        If GetAttr(Current_Path & String_FileName) And vbDirectory Then
            Integer_Directory = Integer_Directory + 1               'Compte le nombres de sous dossiers
            ReDim Preserve String_DirectoryList(Integer_Directory)  'Ajoute dans un tableau temporaire le sous dossier
            String_DirectoryList(Integer_Directory) = Current_Path & String_FileName
        End If
    End If
    String_FileName = Dir
LoopIf Recup_UnderFolder True Then                                    'Si UnderFolder True then
    For Integer_N = 1 To Integer_Directory                          'Boucle la procedure pour lister les sous repertoire
        PROCEDURE_RECURSETREE String_DirectoryList(Integer_N) & "", Use_Form, ListBox_File, False, ListBox_Racine, True
    Next Integer_N
End If

End Sub

2. La ligne de code qui te permet d'utiliser la procedure.
PROCEDURE_RECURSETREE "C:\windows", Me, List1, False, List2, True

3. Avant de lancer la ligne de code pense a crée deux ListBox, List1 contient les noms de fichier, List2 contient les noms des repertoires.

Normalement tu as tout. J'espere que ca marchera.

Bonne chance.

PROTEUS
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
52
Messages postés
10
Date d'inscription
dimanche 19 octobre 2008
Statut
Membre
Dernière intervention
21 octobre 2009

Merci pour l'aide.  La fonction Dir me renvoie bien un nom de répertoire.  Par contre, il faut que je puisse prendre tous les noms de répertoires et je ne connais pas une fonction qui me permette de les compter !
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
52
Je reposte la meme chose à voir si maintenant cela passe mieux et si tu nous en dit un peu plus...

Salut,
Sinon il faut chercher sur www.codyx.org

il y a:
http://www.codyx.org/snippet_liste-tous-fichiers-disque-dur_426.aspx

ou bien encore

http://www.codyx.org/snippet_lister-sous-repertoires-ou-sous-sous-repertoires-repertoire_260.aspx

@+: [../c.aspx?u=aHR0cDovL3d3dy5teXNwYWNlLmNvbS9hcG9zdGFzeTIx Ju£i€n]
Pensez: Réponse acceptée

@+: Ju£i€n
Pensez: Réponse acceptée
Messages postés
10
Date d'inscription
dimanche 19 octobre 2008
Statut
Membre
Dernière intervention
21 octobre 2009

Merci à tous pour votre aide.  J'ai enfin réussi à réaliser ce que je voulais.  Si quelqu'un veut le programme, je peux le joindre.  je me suis fort inspirée de la solution d'Orohena.  J'ai été un peu lente à la résolution, mais je n'ai pas beaucoup de temps à y consacrer.  Mes collègues qui vont utiliser l'application sont super contents du résultat, c'est ce qui compte.

Bien à vous,