Macro pour créer un répertoire de fichier via l'hyperlien

Bonjour,

Voici mon souhait, après avoir appliqué un filtre, j'aimerais créer un répertoire (peu importe ou) de photo à partir des hyperliens "photo".

La colonne où on voit "photo" est une formule complexe qui se crée est le contexte, et si on clique sur le mot "photo" sur chacune des lignes, une photo au format tif ou jpg est affichée avec un programme externe (viewer par défaut de windows).

J'aimerais avec une macro, que toutes les lignes trouvées avec le filtre, copie une version JPG des photos de chaque ligne dont le lien hypertexte est dans la colonne photo.

crop du tableau excel...

p.s. s'il n'est pas possible de créer un répertoire à partir de la macro, je peux créer mes répertoires d'avance et d'indiquer au cas par cas ou je souhaite sauvegarder

Merci

Bonjour Mtek

Peux-tu donner un exemple d'hyperlink vers les images ? ("/https:..." ou sur le poste de travail?)

Bonjour Gérard

Voici la formule qui crée le liens hypertexte

merci de prendre le temps de m'aider

Je te propose le code de récupération des photos suivant :

Sub downloadPic()
    'Constantes à adapter au contexte
    Const cSheetName = "Feuil1"
    Const cToPathName = "MyPhotos"

    Dim sPath As String
    Dim oFS As Object
    Dim oFolder As Object
    Dim oSheet As Worksheet
    Dim oHL As Hyperlink
    Dim oFile As Object
    Dim sPhotoPath As String
    Dim sPhotoFilename As String

    sPath = ThisWorkbook.Path & "\" & cPathName

    'Création d'un object FSO pour gérer le dossier et les fichiers photos
    Set oFS = CreateObject("Scripting.FileSystemObject")

    Set oSheet = ThisWorkbook.Worksheets(cSheetName)

    'Si le dossier de stockage des photos n'existe pas, on le crée.
    If Not oFS.Folderexists(sPath) Then
        oFS.Createfolder (sPath)
    End If

    For Each oHL In oSheet.Hyperlinks
        sPhotoPath = oHL.Address
        sPhotoFilename = Mid(sPhotoPath, InStrRev(sPhotoPath, "\") + 1)
        'On s'assure que l'adresse de la photo n'est pas vide
        If Len(sPhotoPath & "") > 0 Then
            'On s'assure que la photo existe
            If oFS.Fileexists(sPhotoPath) Then
                'On recopie la photo dans le dosssier
                Set oFile = oFS.getfile(sPhotoPath)
                oFile.Copy sPath & "\" & sPhotoFilename
            End If
        End If
    Next

    'on fait le ménage
    Set oFS = Nothing
    Set oSheet = Nothing
End Sub

NB: En tête de la macro, tu dois indiquer le nom correct de la feuille qui contient les photos dans la constante 'cSheetName' et le nom du sous-dossier du dossier du classeur qui en recevra les copies de photos dans la constante 'cToPathName'.

Bonjour Gérard

J'essais la macro mais j'ai un message d'erreur qui je crois viendrait du nom de la feuille qui est "Inventaire TOILES" du à l'espace dans le nom....

Donc, lorsque je met le nom de la feuille dans la macro "Inventaires TOILES" rien ne se passe ou si tu veux, je ne vois rien se passer

Si je replace le nom de la feuille dans la macro par "Feuil1" je reçois

le message d'erreur suivant

merci

ps.s ton aide est vraiment apprécié

Bonsoir Mtek,

As-tu la possibilité de joindre le classeur an laissant juste subsister la feuille "Inventaires TOILES" et une seule ligne contenant un lien vers une photo?

Bonjour Gérard

Les photos sont sur mon disque réseaux, la feuille fonction en relation avec plusieurs autre feuille, je vais tenter de voir de quel façon je pourrait enlever les informations et feuilles non pertinentes au problème...

Autre question, dans le code que tu me proposes, le nom de ma feuille contient un espace, et dans ton code tu as mis "Feuil1" que j'ai remplacé par le nom de ma feuille contenant un espace... y a t'il une façon particulière d'écrire le nom contenant un espace si ça fonctionne avec un nom contenant ou pas un espace ??

Mtek,

Non, il n'y a pas une façon particulière de faire référence à une feuille dont le nom comporte un espace.

Peux-tu juste vérifier le nom de cette feuille car dans ta réponse tu indiques un fois "Inventaires TOILES" et une autre fois "Inventaire TOILES" (sans 's')...

Bonjour Gérard,

hmmm je refais le test en portant attention à ce détail

merci encore de ton aide

Bonjour Gérard,

J'ai refais le test en prenant soin de vérifier l'exactitude du nom de la feuille...

je sélectionne quelque liens (photo de la colonne L) et exécute la macro... rien ne se produit !!!

merci encore