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 :
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.
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 :
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 :
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.
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
Merci beaucoup j’ai gagné un temps incroyable avec votre programme !
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
Merci, très bien expliqué et très utile many thanks !
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
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 !
Merci beaucoup c’est super
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))