Rechercher un fichier (.xlm) dans répertoire et hyertexte

Le 11/10/2017 à 12:44

Bonjour à tous,

Je souhaiterai faire une macro qui pourrait me permettre de rechercher un fichier (.xlm) au travers de dossiers et sous dossiers en fonction du contenu d'une cellule.

J'ai conscience que ceci est faisable relativement facilement en VBA mais je souhaiterai compliquer cette macro afin quelle me répète la première étape sur plusieurs cellules l'une en dessous de l'autre...

Et la touche finale serait que la macro convertisse toutes mes cellules en liens hypertexte me permettant ainsi en un clique sur mon bouton d'avoir tous mes liens vers tous mes fichiers

A noter également que la liste peut changer d'un jours sur l'autre

Donc voilà si vous pouvez m'aider à ce sujet je vous en serait très reconnaissant

Je met le fichier en PJ pour vous aider à mieux comprendre

Merci d'avance

11test.xlsx (9.04 Ko)
Le 11/10/2017 à 13:31

Bonjour,

une solution via une macro. vérifie bien l'extension ! j'ai laissé .xlm mais je ne crois pas que ce soit celle que tu souhaites (.xml ou .xlsm ?)

Sub aargh()
    Sheets("feuil1").Activate
    On Error Resume Next
    ActiveSheet.Hyperlinks.Delete    'suppression de tous les hyperliens dans la feuille
    On Error GoTo 0
    dl = Cells(Rows.Count, 1).End(xlUp).Row    ' nombre de fichiers à chercher
    Set r = Range("B2:B" & dl)    ' plage des fichiers à chercher
    rep = "d:\documents"    ' répertoire de départ
    lfif rep, r    ' recherche des fichiers
    MsgBox "traitement terminé"
    Application.StatusBar = ""
End Sub
Sub lfif(folder, r)
    Set fold = CreateObject("Scripting.FileSystemObject").GetFolder(folder)
    Application.StatusBar = folder
    For Each f In fold.SubFolders
        If Right(f, 1) <> "\" Then lfif f & "\", r Else lfif f, r
    Next
    For Each f In fold.Files    'on prend le nom d'un fichier du répertoire
        If InStr(ucase(f), ".XLSM") <> 0 Then ' sélection de l'extension
            fname = Mid(f, InStrRev(f, "\") + 1)    ' on adapte son nom au format de la liste, suppression du chemin
            On Error Resume Next
            fname = Left(fname, InStr(fname, ".") - 1)    ' suppression de l'extension
            On Error GoTo 0
            Set re = r.Find(fname, lookat:=xlWhole)    'on cherche le nom dans la liste
            If Not re Is Nothing Then    'si trouvé
                With ActiveSheet    'on ajoute l'hyperlien
                    .Hyperlinks.Add Anchor:=re, Address:=f, TextToDisplay:=re.Value & ""
                End With
            End If
        End If
    Next
End Sub
Le 12/10/2017 à 09:18

Bonjour h2so4,

Tout d'abord merci pour ta réponse.

Alors pour répondre à ta question il s'agit en fait d'un fichier xlsm ^^

Sinon j'ai essayé ta macro et malheureusement le lien hypertexte ne fonctionne pas... la macro se lance bien et se termine bien mais je n'ai pas le liens...

J'ai juste modifié le chemin d'accès et l'extension du fichier, Est-ce que je dois modifier autre chose ?

Merci d'avance.

Le 12/10/2017 à 09:39
Bastien-76 a écrit :

Bonjour h2so4,

Tout d'abord merci pour ta réponse.

Alors pour répondre à ta question il s'agit en fait d'un fichier xlsm ^^

j'ai adapté le code voir plus haut

Sinon j'ai essayé ta macro et malheureusement le lien hypertexte ne fonctionne pas... la macro se lance bien et se termine bien mais je n'ai pas le liens...

pas de lien, c'est qu'aucun fichier n'est trouvé. donne un exemple de ce qu'il aurait dû trouver .

fichierA -> d:\documents\test\fichierA.xlsm

J'ai juste modifié le chemin d'accès et l'extension du fichier, Est-ce que je dois modifier autre chose ?

non[quote]
Le 12/10/2017 à 09:49

Merci d'avoir répondu rapidement,

Et bien il aurait dû trouvé un dossier ou un fichier portant le même nom que ce qui est inscrit dans la cellule...

Par exemple j'ai un fichier qui s'appel : "VUT30_100%_1"

Ok d'accord Merci pour la modif de ta macro

Le 12/10/2017 à 10:38
Bastien-76 a écrit :

Par exemple j'ai un fichier qui s'appel : "VUT30_100%_1"

bonjour, ça c'est le nom dans ta liste excel. Quel est le nom de fichier correspondant ?

ps la macro ne fait que les hyperliens vers des fichiers pas vers des répertoires.

Le 12/10/2017 à 10:49

Et bien justement, mon fichier porte exactement le même nom que ma cellule.

C'est à dire que que j'ai à la fois ma cellule avec : "VUT30_100%_1" mais aussi mon fichier(.xlsm) recherché qui s'appel :"VUT30_100%_1"

Et ainsi de suite pour toute ma colonne sur mon tableur Excel. Ainsi, si dans mon tableur j'ai 170 cellules remplies j'aurais également 170 fichiers à rechercher...

Après si besoins je peux modifier le remplissage des cellules ou le nom des fichiers si ça peut faciliter la chose

Le 12/10/2017 à 12:10
Bastien-76 a écrit :

Et bien justement, mon fichier porte exactement le même nom que ma cellule.

C'est à dire que que j'ai à la fois ma cellule avec : "VUT30_100%_1" mais aussi mon fichier(.xlsm) recherché qui s'appel :"VUT30_100%_1"

Et ainsi de suite pour toute ma colonne sur mon tableur Excel. Ainsi, si dans mon tableur j'ai 170 cellules remplies j'aurais également 170 fichiers à rechercher...

Après si besoins je peux modifier le remplissage des cellules ou le nom des fichiers si ça peut faciliter la chose

peux-tu mettre le nom complet du fichier (chemin compris ) et indiquer ce que tu as mis comme répertoire de départ ?

Le 12/10/2017 à 12:41

Ah non en fait c'est bon, j'avais mal tapé une ligne... mais oui du coup c'est bon ça fonctionne parfaitement Merci Beaucoup !

Le 12/10/2017 à 13:16

Et du coup j'aurai une dernière question à te poser : Je souhaiterai remplacer la ligne :

rep = "d:\LocalData\P088623\Desktop\Dossier type"

Par une ligne rendant le choix du dossier de recherche possible ...

J'ai donc pensé à faire une ligne du genre :

rep = Application.GetOpenFilename(, , "Selectionnez un dossier où effectuer la recherche")

Mais cette commande ne me permet de sélectionner seulement un fichier et non un dossier...

Donc si tu peux juste m'éclairer à ce sujet stp, je t'en serait encore plus reconnaissant

Merci d'avance !

Le 12/10/2017 à 13:33

re-bonjour,

avec choix du répertoire de départ

Sub aargh()
    Sheets("feuil1").Activate
    On Error Resume Next
    ActiveSheet.Hyperlinks.Delete    'suppression de tous les hyperliens dans la feuille
    On Error GoTo 0
    dl = Cells(Rows.Count, 1).End(xlUp).Row    ' nombre de fichiers à chercher
    Set r = Range("B2:B" & dl)    ' plage des fichiers à chercher
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        rep = .SelectedItems(1)
    End With
    lfif rep, r    ' recherche des fichiers
    MsgBox "traitement terminé"
    Application.StatusBar = ""
End Sub
Sub lfif(folder, r)
    Set fold = CreateObject("Scripting.FileSystemObject").GetFolder(folder)
    Application.StatusBar = folder
    For Each f In fold.SubFolders
        If Right(f, 1) <> "\" Then lfif f & "\", r Else lfif f, r
    Next
    For Each f In fold.Files    'on prend le nom d'un fichier du répertoire
        If InStr(UCase(f), ".XLSM") <> 0 Then    ' sélection de l'extension
            fname = Mid(f, InStrRev(f, "\") + 1)    ' on adapte son nom au format de la liste, suppression du chemin
            On Error Resume Next
            fname = Left(fname, InStr(fname, ".") - 1)    ' suppression de l'extension
            On Error GoTo 0
            Set re = r.Find(fname, lookat:=xlWhole)    'on cherche le nom dans la liste
            If Not re Is Nothing Then    'si trouvé
                With ActiveSheet    'on ajoute l'hyperlien
                    .Hyperlinks.Add Anchor:=re, Address:=f, TextToDisplay:=re.Value & ""
                End With
            End If
        End If
    Next
End Sub
Le 12/10/2017 à 14:49

Aaaah parfait !!!

Merci beaucoup !

Le 12/10/2017 à 15:03

Oups ! m'a trompé de sujet !!!

@ bientôt

LouReeD

Rechercher des sujets similaires à "rechercher fichier xlm repertoire hyertexte"