arborescence avec lien

Le
Greg
Bonjour à tous!

Je cherche un fichier, qui doit certainement dejà exister, En fait, en
indiquant dans un userform ou dans une cellule (ou je ne sais où, peu
importe du moment que c'est accessible sans rentrer dans la macro, pour les
utilisateurs non avertis), la racine de l'aborescence, excel génèrerait la
liste des dossiers (en colA), des sous dossiers et fichiers (en colB),
..

Le fin du fin serait que chacune des cellules soit clicables pour ouvrir le
dossier ou fichier.

Merci de m'orienter car après quelques recherches, je n'ai pas trouvé ce
modèle qui doit surement exister

Greg
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Patrick BASTARD
Le #17468311
Bonjour, Greg.

Un p'tit tour sur Excelabo, une recherche sur repertoire t'aurait dirigé
vers le classeur de Frédéric Sigonneau
http://www.excelabo.net/compteclic.php?nom=nom-fichier-SANS-extension
qui nous propose ce code à placer dans un module :
Option Explicit

Sub TousFichiersDunDossier()
Dim FSO As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, i As Integer
Dim Sh As Worksheet
Dim EnTetes, ArrFSO

Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
'adapter le dossier racine si besoin
NomDossier = ChoixDossierFichier("")
If NomDossier = "" Then Exit Sub
Set Dossier = FSO.GetFolder(NomDossier)

Set Files = Dossier.Files
If Files.Count <> 0 Then
Set Sh = Sheets.Add
EnTetes = Array("Chemin", "Nom", _
"Date création", "Date dernière modification", _
"Date dernier accès", "Taille", "Type", "Attribut(s)")
'mise en forme
With ActiveSheet.Range("A1:H1")
.Value = EnTetes
.Font.Bold = True
.Interior.ColorIndex = 43
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
i = 1
For Each File In Files
i = i + 1
With File
ArrFSO = Array(.ParentFolder & "", .Name, .DateCreated, _
.DateLastModified, .DateLastAccessed, .Size, .Type)
End With
Sh.Cells(i, 1). _
Resize(1, UBound(ArrFSO) - LBound(ArrFSO) + 1).Value = ArrFSO
Sh.Cells(i, UBound(ArrFSO) + 2).Value = Attributs(File.Attributes)
Next
End If
Sh.UsedRange.EntireColumn.AutoFit
Set FSO = Nothing: Set Sh = Nothing
Set Dossier = Nothing: Set File = Nothing
End Sub

Function Attributs(Attrib)
Dim Res$
If Attrib = 0 Then Res = "Aucun attribut"
If Attrib And 1 Then Res = Res & "/Lecture seule"
If Attrib And 2 Then Res = Res & "/Caché"
If Attrib And 4 Then Res = Res & "/Système"
If Attrib And 32 Then Res = Res & "/Archive"
Attributs = Res
End Function

Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$

If SelType = 0 Then
FlagChoix = &H1&: Msg = "Choisissez un dossier :"
Else
FlagChoix = &H4000&: Msg = "Choisissez un fichier :"
End If

Set objShell = CreateObject("Shell.Application")
'le troisième paramètre permet de choisir
'la sélection d'un dossier ou d'un fichier (0 ou 1)
'le dernier paramètre permet de choisir le dossier racine
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix, Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
Chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoixDossierFichier = Chemin
End Function

"Greg" news:48ed94cb$0$18581$
Bonjour à tous!

Je cherche un fichier, qui doit certainement dejà exister, En fait, en
indiquant dans un userform ou dans une cellule (ou je ne sais où, peu
importe du moment que c'est accessible sans rentrer dans la macro, pour
les utilisateurs non avertis), la racine de l'aborescence, excel
génèrerait la liste des dossiers (en colA), des sous dossiers et fichiers
(en colB), ........

Le fin du fin serait que chacune des cellules soit clicables pour ouvrir
le dossier ou fichier.

Merci de m'orienter car après quelques recherches, je n'ai pas trouvé ce
modèle qui doit surement exister...

Greg




Daniel.C
Le #17468771
Regarde le classeur à l'adresse :
http://cjoint.com/?kjlzAHhQOR
Il suffit de presser le bouton !
--
Cordialement.
Daniel
"Greg" 48ed94cb$0$18581$
Bonjour à tous!

Je cherche un fichier, qui doit certainement dejà exister, En fait, en
indiquant dans un userform ou dans une cellule (ou je ne sais où, peu
importe du moment que c'est accessible sans rentrer dans la macro, pour
les utilisateurs non avertis), la racine de l'aborescence, excel
génèrerait la liste des dossiers (en colA), des sous dossiers et fichiers
(en colB), ........

Le fin du fin serait que chacune des cellules soit clicables pour ouvrir
le dossier ou fichier.

Merci de m'orienter car après quelques recherches, je n'ai pas trouvé ce
modèle qui doit surement exister...

Greg



Greg
Le #17477061
Bonsoir Daniel,

A force de vous cotoyer, je me doutais que c'est toi qui répondrait à ce
message, que tu serai l'homme de la situation!

Ce fichier correspond exactement à mon attente, à deux petits détails prêt:
- ce sont les chemins qui s'affiche, avec au terme évidemment le nom de
dossier, et non les noms de dossiers tout simplement
- En ce qui concerne les fichiers, ils s'affichent avec leur extension.
Est-il possible de les en libérer?

Merci de ton coup de main.

Greg

NB: Merci également à Patrick pour sa collaboration.
Daniel.C
Le #17478891
> A force de vous cotoyer, je me doutais que c'est toi qui répondrait à ce
message, que tu serai l'homme de la situation!




Bonjour.
En l'occurence, le classeur est bâti d'après un classeur de JB. J'avais
oublié de citer mas sources; c'est fait.

Ce fichier correspond exactement à mon attente, à deux petits détails
prêt:
- ce sont les chemins qui s'affiche, avec au terme évidemment le nom de
dossier, et non les noms de dossiers tout simplement
- En ce qui concerne les fichiers, ils s'affichent avec leur extension.
Est-il possible de les en libérer?



Là, je suis pressé. Le classeur suivant va fonctionner pour les extensions à
3 caractères, pas pour les fichiers du type ".xlsm" par exemple.
http://cjoint.com/?kkircZrhSH
Cordialement.
Daniel
Greg
Le #17505401
Bonsoir Daniel,

Désolé pour ma réponse tardive mais j'ai quelques problèmes avec mon ordi.

En fait, le dernier fichier que tu me proposes répond au problème que
j'évoquais et maintenant, seul le nom du dossier ou du fichier apparait.
C'est au poil!

Par contre, le résultat obtenu ne rend pas vraiment compte de
l'arborescence, mais donne le contenu (fichiers en col B) de tous les
dossiers (col A).

J'aurais voulu que les colonnes permettent de rendre compte du niveau du
dossier/du fichier dans l'arborescence (sous dossier et fichiers de la cible
en col A, sous dossiers et fichiers des dossiers en col B, sous-sous
dossiers....... en col C ....)

Est-ce possible?

Merci.

Greg
Daniel.C
Le #17506941
Bonsoir.
Ca complique pas mal le problème. J'y réfléchis demain... sans garantie.
--
Cordialement.
Daniel
"Greg" 48f237db$1$1054$
Bonsoir Daniel,

Désolé pour ma réponse tardive mais j'ai quelques problèmes avec mon ordi.

En fait, le dernier fichier que tu me proposes répond au problème que
j'évoquais et maintenant, seul le nom du dossier ou du fichier apparait.
C'est au poil!

Par contre, le résultat obtenu ne rend pas vraiment compte de
l'arborescence, mais donne le contenu (fichiers en col B) de tous les
dossiers (col A).

J'aurais voulu que les colonnes permettent de rendre compte du niveau du
dossier/du fichier dans l'arborescence (sous dossier et fichiers de la
cible en col A, sous dossiers et fichiers des dossiers en col B, sous-sous
dossiers....... en col C ....)

Est-ce possible?

Merci.

Greg




Greg
Le #17507801
Merci Daniel!

Avec plaisir si tu es as le temps.

Grégory
Daniel.C
Le #17509951
Bonjour.
Regarde le classeur à l'adresse :
http://cjoint.com/?knlctvqKzc
Le code est le suivant :

Public Ctr As Long, racine As String
Sub RechercheFichiers()

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
racine = .SelectedItems(1)
End With
If racine = "" Then Exit Sub
Cells.Clear
Ctr = 0
'Set fso = New Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
End Sub
Sub Lit_dossier(ByRef dossier)
Dim Decal As Integer
Decal = UBound(Split(dossier.Path, "")) - UBound(Split(racine, "")) + 1
Decal = 1 + (Decal - 1) * 2
Ctr = Ctr + 1
Cells(Ctr, Decal).Interior.ColorIndex = 6
Cells(Ctr, Decal) = dossier.Path
ActiveSheet.Hyperlinks.Add Cells(Ctr, Decal), dossier.Path,
TextToDisplay:=dossier.Name
For Each f In dossier.Files
Ctr = Ctr + 1
Cells(Ctr, Decal + 1) = f.Name
ActiveSheet.Hyperlinks.Add Cells(Ctr, Decal + 1), _
Address:=dossier.Path & "" & f.Name, _
TextToDisplay:=Left(f.Name, Len(f.Name) - 4)
Next
For Each d In dossier.SubFolders
Lit_dossier d
Next
End Sub

--
Cordialement.
Daniel
"Greg" 48f2727d$0$27664$
Merci Daniel!

Avec plaisir si tu es as le temps.

Grégory



Greg
Le #17515691
Merci Daniel pour ton travail.

Cette fois, la macro ouvre l'ensemble des dossiers à l'endroit indiqué, en
respectant les niveaux de chacun. C'est effectivement ce que je souhaitais.
Par contre, les fichiers n'apparaissent pas dans l'arborescence.

Je sais que je suis gourmand mais le premier fichier donne le contenu de
chaque dossier, le second donne une vision très claire de la hiérarchie des
dossiers. Est-il possible de combiner les 2, c'est à dire visualiser les
fichiers (sans leur extension comme tu l'avais fait sur le classeur
précédent) tout en gardant l'idée des dossiers hierarchiser?

Est-ce complexe de faire apparaitre tout ce qui est dossier en gras,
souligné ou tout autre mise en forme permettant de marquer la différence
entre dossiers et fichiers?

La gourmandise est un vilain défaut... mais ce classeur serait un véritable
plus dans mon travail... et je pense qu'il peut être utile pour pas mal de
monde par ailleurs!

Merci pour moi et pour tous ceux qui auront à utiliser cet outil de
visualisation interactif.

Greg
Daniel.C
Le #17516701
Bizarre, ca fonctionne chez moi, les dossiers ouvrent l'explorateur et les
fichiers s'ouvrent quand on clique sur leur nom :
http://cjoint.com/?knt6KQlBkU
--
Cordialement.
Daniel
"Greg" 48f3794c$0$17215$
Merci Daniel pour ton travail.

Cette fois, la macro ouvre l'ensemble des dossiers à l'endroit indiqué, en
respectant les niveaux de chacun. C'est effectivement ce que je
souhaitais. Par contre, les fichiers n'apparaissent pas dans
l'arborescence.

Je sais que je suis gourmand mais le premier fichier donne le contenu de
chaque dossier, le second donne une vision très claire de la hiérarchie
des dossiers. Est-il possible de combiner les 2, c'est à dire visualiser
les fichiers (sans leur extension comme tu l'avais fait sur le classeur
précédent) tout en gardant l'idée des dossiers hierarchiser?

Est-ce complexe de faire apparaitre tout ce qui est dossier en gras,
souligné ou tout autre mise en forme permettant de marquer la différence
entre dossiers et fichiers?

La gourmandise est un vilain défaut... mais ce classeur serait un
véritable plus dans mon travail... et je pense qu'il peut être utile pour
pas mal de monde par ailleurs!

Merci pour moi et pour tous ceux qui auront à utiliser cet outil de
visualisation interactif.

Greg



Publicité
Poster une réponse
Anonyme