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

Partager cet article

Temps estimé pour la lecture de cet article : 18 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

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. 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.

12 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 !

Laisser un commentaire

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