Excel : insérer une image depuis un lien hypertexte avec une macro

Partager cet article

Temps estimé pour la lecture de cet article : 17 min

Hey !

Récemment, j’ai aidé quelqu’un à réaliser une macro pour excel qui permet à partir d’un lien donné d’insérer une image dans une cellule avoisinante. Ici, la problématique était simple, il fallait pouvoir insérer 2200 images à partir de 2200 liens. Cela ne pouvait donc pas être décemment réalisé à la main. Voici, exactement en exemple la situation :

Excel - selection

Créer une macro Excel

On possède donc un ensemble de liens, que l’on va sélectionner, on aimerait pouvoir pour chaque lien, insérer une image dans la colonne adéquate. Pour ce faire nous allons réaliser une macro. Rien de plus simple : Affichage -> Macros -> Afficher les macros. Donner un nom à votre macro, puis appuyez sur créer. Sélectionner là et choisissez options.

Excel - macro

On va pouvoir ainsi, attribuer un raccourci à notre macro. Moi j’ai choisi par exemple le raccourci, ctrl+j.

Code de notre macro qui permet d’insérer une image depuis un lien hypertexte

Voyons maintenant en détail le code de notre macro :

Sub LinkToImage()
    For Each cel In Selection
        cel.Offset(0, 2).Select
        cel.Offset(0, 2).RowHeight = 100
        cel.Offset(0, 2).ColumnWidth = 40
        
        Set image = ActiveSheet.Pictures.Insert(cel.Value)
    
        With image
            .ShapeRange.LockAspectRatio = msoTrue
            .Width = cel.Offset(0, 2).Width
            .Height = cel.Offset(0, 2).Height
            .Left = cel.Offset(0, 2).Left
            .Top = cel.Offset(0, 2).Top
        End With
    
    Next cel

End Sub

Pour chaque cellule dans notre sélection (cela correspond au for each), on sélectionne la cellule qui se situe deux rangs à droite de notre cellule (ici donc la colonne image). Pour là cellule ainsi récupérée, on attribue une hauteur et une largeur donnée et on insère une nouvelle image sur cette cellule.

Enfin, pour cette image créée, on attribue la taille de cette dernière afin qu’elle respecte la largeur et la hauteur de notre cellule. On fait en sorte que l’homothétie de l’image soit respectée grâce à l’option msoTrue, si on passait cette option à false. L’image prendrait toute la largeur et la hauteur de la cellule, toutefois en déformant l’image.

Ce qui nous donne, pour l’exemple du début :

Excel - resultat

Vérifier si l’image existe afin d’afficher un message personnalisé

Suite à la demande d’Eric, voici donc un exemple plus complet qui va vous permettre de vérifier, si l’image que vous essayez de chercher existe, c’est-à-dire si la page ne retourne pas une erreur, donc si le retour du header est un status 200. On vérifie également si l’url contient tout simplement un lien vers une image en vérifiant l’extension.

Voila donc la macro final :

Sub LinkToImage()
    For Each cel In Selection
        cel.Offset(0, 2).Select
        cel.Offset(0, 2).RowHeight = 100
        cel.Offset(0, 2).ColumnWidth = 40
        
        If URLValid(cel.Value) = 0 Or HttpExists(cel.Value) = 0 Then
           cel.Offset(0, 2).Value = "Photo non dispo"
        Else
            Set Image = ActiveSheet.Pictures.Insert(cel.Value)
            With Image
                .ShapeRange.LockAspectRatio = msoTrue
                .Width = cel.Offset(0, 2).Width
                .Height = cel.Offset(0, 2).Height
                .Left = cel.Offset(0, 2).Left
                .Top = cel.Offset(0, 2).Top
            End With
        End If
    Next cel
 
End Sub

Function URLValid(url As String) As Boolean
    If InStr(url, "png") > 0 Then
        URLValid = True
    ElseIf InStr(url, "jpg") > 0 Then
        URLValid = True
    ElseIf InStr(url, "jpeg") > 0 Then
        URLValid = True
    ElseIf InStr(url, "bmp") > 0 Then
        URLValid = True
    Else
        URLValid = False
    End If
End Function

Function HttpExists(ByVal sURL As String) As Boolean
    Dim oXHTTP As Object
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    On Error GoTo haveError
    oXHTTP.Open "HEAD", sURL, False
    oXHTTP.send
    HttpExists = IIf(oXHTTP.Status = 200, True, False)
    Exit Function
haveError:
    Debug.Print Err.Description
    HttpExists = False
End Function

Et le petit test qui va bien :

excel-macro-images

Vérifier si le fichier existe sur le disque dur

Si vous voulez plus simplement juste vérifier si le fichier existe sur le disque dur, vous pouvez utiliser la fonction getAttr(), elle vous permet de vérifier l’état du fichier (disponible en lecture/écriture…), ce qui nous donne donc :

Sub LinkToImage()
    For Each cel In Selection
        cel.Offset(0, 2).Select
        cel.Offset(0, 2).RowHeight = 100
        cel.Offset(0, 2).ColumnWidth = 40
         
        If IsFile(cel.Value) = 0 Then
           cel.Offset(0, 2).Value = "Photo non dispo"
        Else
            Set Image = ActiveSheet.Pictures.Insert(cel.Value)
            With Image
                .ShapeRange.LockAspectRatio = msoTrue
                .Width = cel.Offset(0, 2).Width
                .Height = cel.Offset(0, 2).Height
                .Left = cel.Offset(0, 2).Left
                .Top = cel.Offset(0, 2).Top
            End With
        End If
    Next cel
  
End Sub
 
Function IsFile(fName As String) As Boolean
    On Error Resume Next
    IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function

Sayōnara.

14 comments

  1. Merci énormément pour cette macro qui me rend bien service !
    Que faudrait-il ajouter à cette macro pour que si elle ne trouve pas la photo (disparue, mal nommée etc.) elle affiche un msg (« photo non dispo ») et qu’elle passe à la ligne suivante ?

    Merci d’avance 🙂

    Eric

    • De rien, c’est un plaisir ! J’ai mis à jour l’article afin de montrer un exemple de macro qui permet de vérifier si l’url est valide. Tu n’as plus qu’à changer la ligne 8, afin d’afficher le message que tu veux 🙂

      Cordialement,
      Ludovic

    • Merci beaucoup Ludovic pour cette mise à jour !

      Bon, ça ne marche plus pour moi, parce que j’avais omis de préciser la source des images : pas une url, mais un dossier sur mon PC avec une simple adresse C:\ Documents and Settings\…..\xxx.jpg

      Tant pis, mais cette mise à jour rendra surement service à un autre 😉

      Bonne journée !

      Eric.

    • Arf, du coup en faisant ma mise à jour hier, j’ai vu comment faire pour des fichiers, c’est beaucoup plus simple, tu me l’aurais précisé ça aurait été plus rapide :p ! Du coup, je remettrai le poste à jour ce soir 🙂
      Bonne journée à toi aussi.

      Ludovic

      Edit: c’est fait 😀 !

    • Merci Ludovic, ça fonctionne parfaitement ! Tu es génial ! 😉

      Juste un soucis, peut-être lié à ma version d’Excel ( 2003 …) sur le redimensionnement homothétique des images… Elles remplissent systématiquement la cellule, donc sont déformées…
      Alors que tu ne sembles pas rencontrer ce problème lors de tes tests .
      En redimensionnant la taille de la cellule dans la macro pour coller au rapport H/L de mes images (3/2) je contourne aisément le problème, pas de soucis !

      Encore merci !

      Eric

  2. Bonjour

    Merci beaucoup pour ce tuto, j’ai essayé de l’appliquer mais j’ai une erreur qui me dit : impossible de lire la propriété insert de la classe picture
    Le probleme semble venir de la : Set Image = ActiveSheet.Pictures.Insert(cel.Value)

    Merci de votre retour

    • Bonjour Franck,

      Il va me falloir plus d’informations pour vous aider quelle version d’excel utilisez-vous ? Quel type de lien essayer vous de charger : local ou url ?

      Cordialement,
      Ludovic

  3. Bonjour Ludoo et merci pour ce tuto.

    J’ai le même problème que franck, à savoir : impossible de lire la propriété insert de la classe picture
    J’utilise Office Pro plus 2013 et les images sont stockées dans le dossier racine de mon classeur excel.
    Hier la fonction fonctionnait, mais aujourd’hui plus rien. Photo non disponible, et si je supprime la fonction d’insérer un texte s’il ne trouve pas la photo, il ne dit qu’il est impossible de lire la propriété insert.
    Peux tu m’aider s’il te plaît ?
    Merci à toi !

    • Salut Quentin,

      Alors, je pense que cela vient du chemin que tu fournis, pour ton image, que donnes-tu comme lien au final ? Tu mets directement le nom de l’image ?
      Du genre: « test.jpg », si c’est le cas peut-être que tu es obligé de donner un lien absolu.
      Je t’avoue qu’actuellement, je ne tourne plus sous Windows, je suis passé totalement à linux, c’est donc un peu compliqué de d’aider.

      Bonne journée.
      Ludo

  4. Bonsoir
    merci vraiment pour ce tuto fort utile et très bien expliqué qui m’a évité de perdre beaucoup de temps à chercher comment réaliser, écrire, enregistrer et excéuter une macro.
    Merci infiniment !

  5. Merci beaucoup !
    J’avais besoin de lier dans un tableau plus de 1000 images de code barre avec leurs références, et après 2 jours de recherches, je tombe sur cette petite pépite de macro qui m’a tout résolu.
    (NB : j’ai juste fait une toute petite modification car j’avais un décalage léger, mais exponentiel, entre le bas des image et les hauteurs de lignes constantes (il suffit de seulement conservé l’attribut Height de l’objet Shaperange))

Laisser un commentaire

Votre adresse e-mail ne sera pas publiée. Les champs obligatoires sont indiqués avec *

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur comment les données de vos commentaires sont utilisées.