[Résolu] Macro pour lien hypertexte

[Polobe36]

bonjour à tous, salut le forum,

j'aurai besoin d'un petite macro qui me permettrait de créer des liens hypertextes dans un fichier excel vers des fichiers dans des dossiers.

Je me suis organisé comme tel:
- j'ai dans différents dossiers des fichiers powerpoint (tous ne sont pas dans un seul et unique dossier)
- dans un fichier excel, j'ai une feuille dans laquelle il y a une colonne avec le nom du fichier powerpoint.

L'idée serait de lier une cellule en allant chercher l'adresse du fichier du même nom

Je ne connais pas le langage vba, aussi merci de me venir en aide.

Bonne journée

 

[mromain]

Re : Macro pour lien hypertexte

Bonjour Polobe, le forum

Ci-joint une solution. Le classeur est composé de 2 feuilles :

1. ListeFichiers composée de deux parties
   • le paramétrage de la recherche de fichiers (chemin du dossier, recherche de sous-dossier, rafraichissement)
   • la liste des fichiers correspondants. Cette liste est mise à jour par macro.
2. Sheet1 qui est un simple exemple qui recherche le chemin d'un fichier à partir de son nom et crée un lien hypertexte.

Pour mettre en œuvre cette solution dans un autre classeur, copier la feuille ListeFichiers dans le classeur destination, et rajouter ce code dans l'objet ThisWorkbook du classeur destination :

Private Sub Workbook_Open()
    If CBool(SheetFileList.Cells(3, 2).Value) Then SheetFileList.RefreshFolderInfo
End Sub

Note : selon le nombre de dossiers/sous-dossiers et fichiers, la mise à jour peut prendre du temps...
A+

 

[Polobe36]

Re : Macro pour lien hypertexte

Bonjour le forum, bonjour mromain,

Merci pour ta réponse çà fonctionne nickel, me reste plus qu'à l'intégrer dans le classeur de destination.

Merci encore

 

[Polobe36]

Re : Macro pour lien hypertexte

Bonjour mromain, le forum,

Existe t'il une solution plus rapide en terme de traitement?
J'ai besoin de "scanner" une arborescence de 70000 fichiers (des plans)... et vu que les budgets sont restreints pour mettre en place une gestion de plans, j'aimerai trouver une parade simple et efficace. En effet, une telle mise à jour prend énormément de temps (+ de 6h) et surcharge le réseau.

Merci de votre aide

 

[mromain]

Re : Macro pour lien hypertexte

Bonsoir Polobe,

Désolé, je n'avais pas vu ton précédent message... Sinon, non je ne connais pas de bonne solution pour scanner un répertoire rapidement...
Concernant ton autre problème (et si je comprend bien ) il suffit de changer le paramétrage en cellule C2 (Analyser les sous-dossiers).

A+

 

[Polobe36]

Re : Macro pour lien hypertexte

Bonjour mromain, le Forum,

Pour rebondir sur le premier sujet, lorsque j'ai besoin de mettre à jour cette arborescence de dossiers (70000 plans environs rien que çà) je le fais de nuit, où alors depuis un autre poste que le mien. Ce qui est embêtant c'est le temps d'exécution mais bon tanpis.

Autrement pour la seconde demande, désolé mais ta réponse n'était pas ce que j'attendais, ou plutôt je me suis mal exprimé:
Je souhaiterai savoir si au travers de cette méthodes, je pouvais retrouver dans la liste qui en résulte les fichiers compris dans un ou plusieurs dossiers (çà c'est ok) mais aussi le nom (et donc lien) des dossiers en tant que tel.

Par exemple pour C:\user\photos\photo1.jpg, j'aimerais retrouver à l'issue de l'exécution de la macro la liste suivante:
- photo1.jpg
- photos (le dossier parent de photos1.jpg).

Si c'est au travers d'une seconde macro çà ne me dérange pas.

Bonne journée

 

[MJ13]

Re : Macro pour lien hypertexte

Bonjour Polobe, Mickaël

En général, on peut utiliser la fonction shell ex: Dir>MyDir.txt pour avoir la liste des fichiers assez rapidement.

 

[Polobe36]

Re : Macro pour lien hypertexte

Bonjour à tous, mromain,

Je suis passé sous office 2013 et depuis le code que tu m'a fourni ne fonctionne plus, où du moins l'application ne reconnait plus l'objet (?) "Format".

Private Sub ListFilesInt(pathFolder As String, checkSubFolder As Boolean, ByRef result() As String, ByRef iFile As Long)
Static myFso As Object
Dim fold As Object, curFile As Object, curFold As Object, tabStr() As String, ext As String
If myFso Is Nothing Then Set myFso = CreateObject("Scripting.FileSystemObject")
If Not myFso.FolderExists(pathFolder) Then Exit Sub
Set fold = myFso.GetFolder(pathFolder)
For Each curFile In fold.Files
tabStr = Split(curFile.Name, ".")
ext = tabStr(UBound(tabStr))
iFile = iFile + 1: ReDim Preserve result(1 To 7, 1 To iFile)
result(1, iFile) = curFile.Path
result(2, iFile) = curFile.Name
result(3, iFile) = Replace(curFile.Name, "." & ext, vbNullString)
result(4, iFile) = ext
result(5, iFile) = fold.Path
result(6, iFile) = Format(curFile.DateCreated, "yyyy.mm.dd")
result(7, iFile) = Format(curFile.DateLastModified, "yyyy.mm.dd")
Next curFile
If Not checkSubFolder Then Exit Sub
For Each curFold In fold.SubFolders
ListFilesInt curFold.Path, True, result, iFile
Next curFold
End Sub

Comment dois-je résoudre cela?
Merci par avance du coup de main