Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

conversion arborescence de répertoire en fichier excel

535 views
Skip to first unread message

Ben

unread,
Apr 25, 2008, 11:41:07 AM4/25/08
to
Bonjour,

Je cherche à sauvegarder une arborescence de dossiers de l'explorateur
sous format excel.
En d'autres termes, pour que ce soit plus clair, je cherche à garder le
classement de mes dossiers (répertoire perso) dans un fichier excel.

Je vous remercie d'avance pour vos lumières

Ben


Misange

unread,
Apr 25, 2008, 11:46:00 AM4/25/08
to
Bonjour

de multiples solutions et des exemples à télécharger ici
http://www.excelabo.net/excel/repertoiresarborescence.php

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Ben a écrit :

Misange

unread,
Apr 25, 2008, 12:49:30 PM4/25/08
to
Le dossier est un argument de la macro, il doit donc lui être passé en
paramètre.
pas le temps maintenant mais tu as des exemples tout faits aussi ici

si tu es avec excel 2007
http://www.excelabo.net/moteurs/compteclic.php?nom=fc-filesearch07

sinon
http://www.excelabo.net/moteurs/compteclic.php?nom=mpfc-repertoires
http://www.excelabo.net/moteurs/compteclic.php?nom=rd-contenurepertoires
http://www.excelabo.net/moteurs/compteclic.php?nom=jb-arborescencerepertoire
http://www.excelabo.net/moteurs/compteclic.php?nom=lc-evolutionrepertoire

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Ben a écrit :
> Super je suis content que çà existe.
> Par contre, je n'arrive pas à réaliser cette tâche.
> Pour l'instant dans un fichier, excel j'ai copié collé le code dans un
> module normal.
> Puis je suis sorti de VBA et après je lance la macro.
> Il m'apparait alors le message suivant :
> Il doit falloir que je précise l'arbo de mon répertoir mais où puis-je
> le faire ???????
> J'ai rajouté E:\Mes Docs à la place de ledossier mais çà n'a pas marché.
>
>
> Comment est-ce que je peux faire ?
> En vous remerciant d'avance

JRM

unread,
Apr 25, 2008, 1:36:18 PM4/25/08
to
Bonsoir Ben,
Dans la macro "test" adapte le chemin de ton dossier dans la ligne
ci-dessous :
'--------
'Répertoire à adapter
NbDeFichiers "C:\Documents and
Settings\Propriétaire\Bureau\Ton_Dossier", Nb&, taille, True
'--------

Puis lance la macro "test".
Les données sont reproduites en Feuille1. Tu peux modifier cela dans la
ligne ci-dessous :
'----
With Worksheets("Feuil1")
'----
--
Cordialement,
JRM

Ben

unread,
Apr 26, 2008, 5:13:19 AM4/26/08
to
Répertoire de niveau 1 Répertoire de niveau 2
1_FAMILLE 1_PHOTOS
1_FAMILLE 1_PHOTOS
1_FAMILLE 1_PHOTOS
1_FAMILLE 2_CINEMA
1_FAMILLE 2_CINEMA
1_FAMILLE
2_CINEMA
 
 
Ok merci çà marche. Par contre, çà ne répond pas encore à mon besoin.
Mon besoin est le suivant : obtenir l'arborescence de mes répertoires mais ne pas descendre jusqu'au fichier et avoir cette arborescence réparti sur plusieurs colonnes. Le but est d'avoir :
- en colonne 1 : tous les répertoire de niveau 1
- en colonne 2 : tous les répertoires d niveau 2
et etc ...

Celà peut permettre d'effecteur des tris dans l'arborescence et de rapidement cerner de quoi est composé le répertoire.
 
 
Le code suivant est pas mal mais il faudrait ne pas avoir les fichiers et que les répertoires de différents niveau se mettent dans différentes colonnes (cf cidessus).
 
Je vous remercie d'avance pour votre aide.
 
A+
 
BEN

Mishell

unread,
Apr 26, 2008, 9:28:35 AM4/26/08
to
Bonjour.
 
Voici qui me semble répondre à ta demande.
 
Mishell
 
'----------------------------------------
Dim ligne As Integer
Dim chemin As String
 
Private Sub Repertoires_selon_niveaux()
 
 chemin = "c:\aa\"
 
Call DirRep(chemin, "")
Call Classer ' Facultatif
Call Convertir
 
End Sub

Private Sub DirRep(NomRep As String, strExtention As String)
    Dim memDossiers As New Collection
    Dim Dossiers As New Collection
   
    Dim NomFic As String
    Dim i As Integer
    
    If Right(NomRep, 1) <> "\" Then NomRep = NomRep & "\"
    NomFic = Dir(NomRep & "*.*", vbDirectory)
    While NomFic <> ""
        If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
            If (NomFic <> ".") And (NomFic <> "..") Then
                Dossiers.Add NomRep & NomFic
            End If
        End If
        NomFic = Dir
    Wend
 
    ' Appel récursif de la même fonction pour les traiter les sous-dossiers
    While Dossiers.Count > 0
        DirRep Dossiers(1), strExtention
        memDossiers.Add Dossiers(1)
        Dossiers.Remove 1
    Wend
    
     For i = 1 To memDossiers.Count
      ligne = ligne + 1
      Range("A" & ligne) = Mid(memDossiers.Item(i), Len(chemin) + 1)
     Next
   
 
End Sub
 
Sub Classer()
 
    Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
 
Sub Convertir()
 
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1))
End Sub
 
'----------------------------------------

 
0 new messages