Insertion images en masse

Bonjour à tous,

Je cherche à insérer des images en masse selon les "conditions" suivantes :
- Les images sont sur mon disque dur dans un dossier spécifique
- Deux colonnes importantes : Colonne B ou les images devront s'afficher / Colonne D ou sont contenu les références de mes produits
- Les fichiers sont nommés par référence

Pourquoi je cherche à faire cela en masse :
J'ai plus de 15 000 photos / Références.

Comportement recherché : Au lancement de la macro, les images s'importent et se mettent dans les cellules correspondantes.

J'insiste bien sur le fait que les images doivent être importées dans le fichier et non correspondre à un lien.
Le fichier devant être à terme envoyé à mes clients sans que j'ai à envoyer un dossier contenant les images avec.

J'ai recherché beaucoup sur ce forum comme sur d'autres et ça ne colle jamais à ce que j'attends.
En effet, soit il faut envoyer un dossier avec le fichier excel, soit il faut pour chaque image aller sélectionner les images. Ce qui en soit accélère un peu ma tache mais est loin d'être opti.

Pourquoi je ne le fais pas moi même ? Parce que je suis une bille en VBA.
Autant je comprendrais en grande parti le code que j'aurais en face des yeux, autant je suis incapable d'en écrire une ligne.

Par avance, je vous remercie enormément pour l'aide que vous pourrez m'apporter !

Cordialement,

Florian

Bonjour

Serais-tu du genre à faire supporter brutalement (d'un seul coup) à une fourgonnette le poids et l'encombrement de tous les objets dont l'entreposage nécessite toutes les étagères d'un très grand entrepôt ?

Excel (mais pas uniquement et très loin d'être "uniquement"), n'est pas le véhicule adéquat...;)

Bonjour unparia,

Je m'attendais à ce genre de réponse :)
J'ai des fichiers équivalent voir plus gros, avec des photos plus lourde et non optimisés. Sans pour autant que cela n'affecte la capacité d'Excel à traiter les données.

Je suis sur qu'il est capable d'encaisser. Je suis également sur qu'il faudra pas lui faire importer les 15000 images en une demi seconde :D

Je reste persuadé que c'est jouable, parce que malgré tout, Excel est une sacré fourgonnette :D


EDIT :

J'ai commencé à faire quelque chose en utilisant des bout de code ici et là...

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Sub importImage() Folder = ThisWorkbook.Path SubFolder = Folder & "/imgImport/" For i = 5 To 2009 Fullname = SubFolder & Range("D" & i) & ".jpg" Adresse = "B" & i Range(Adresse).Select   ActiveSheet.Shapes.AddPicture Fullname, msoFalse, msoCTrue, 100, 100, 70, 70   Next End Sub

---

Mais j'obtiens une erreur :

Citation:

---

Une erreur s'est produite lors de l'importation de ce fichier.

---

Puis :

Citation:

---

Erreur d'exécution "1004"
Erreur définie par l'application ou par l'objet

---

La ligne mise en jaune au débug est la suivante :

Code:

---

ActiveSheet.Shapes.AddPicture Fullname, msoFalse, msoCTrue, 100, 100, 70, 70

---

J'ai vérifié les dossier et les fichiers, tout est bon, tout est là.
OUI Je saisi la plage manuellement et volontairement de 5 à 2009. Pour commencer "petit"
Comment puis-je obtenir plus d'information concernant cette erreur ?

Merci !

Bonjour
Sans connaitre le code,
je vois une erreur dans le chemin fichier
au lieu d'écrire SubFolder = Folder & "/imgImport/"
il faudrait inverser les barres obliques

Code:

---

SubFolder = Folder & "\imgImport\"

---

Bonjour Tony,

Merci pour votre retour.
Les slashs sont correct, en effet il s'agit d'excel sur MAC :)
Sur Windows, il aurait en effet fallu des antislashs.

Merci !

Re bonjour à tous,

J'ai testé le même code sous Windows :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Sub importImage() Folder = ThisWorkbook.Path SubFolder = Folder & "\imgImport\" For i = 5 To 2009 FullName = SubFolder & Range("D" & i) & ".jpg" Adresse = "B" & i Range(Adresse).Select If Len(Dir(FullName)) > 0 Then   ActiveSheet.Shapes.AddPicture FullName, False, True, 100, 100, 70, 70 End If Next End Sub

---

Et ça fonctionne !

Maintenant, le problème vous vous en douterez, c'est le positionnement des images ainsi que leur dimensions.
En effet, en l'état, TOUTES les images sont à la même position, et sont carré.

Comment dans le même code puis-je faire en sorte que l'image prenne la taille de la cellule, garde ses proportions originales ET soit bien dans les cellules demandées ?

Merci d'avance !

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

Dim c As Range Dim Shp As Picture   ... If Len(Dir(FullName)) > 0 Then Set c = Range("B" & i) Set Shp = ActiveSheet.Pictures.Insert(FullName) With Shp .ShapeRange.LockAspectRatio = msoTrue .Left = c.Left .Top = c.Top .Height = c.Height End With DoEvents End If Next

---

Bonjour Mercatog,

Merci beaucoup pour cette proposition.
Cependant sur les dernières version d'Excel, et si je ne me trompe pas, Pictures.Insert lie les images au fichiers excel. Ce qui nécessite d'envoyer les images dans un dossier avec le fichier excel.
C'est pourquoi j'ai utilisé Shapes.AddPicture qui lui va ajouter les images DANS le fichier.

J'ai donc fini par faire ce code :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Sub importImage() Folder = ThisWorkbook.Path SubFolder = Folder & "\imgDisplateIMPORT\" For i = 5 To 2009 FullName = SubFolder & Range("D" & i) & ".jpg" Adresse = "B" & i   imgTop = Range(Adresse).Top imgLeft = Range(Adresse).Left imgWidth = -1 imgHeight = -1     If Len(Dir(FullName)) > 0 Then   With ActiveSheet.Shapes.AddPicture(Filename:=FullName, linktofile:=msoFalse, _ savewithdocument:=msoCTrue, Left:=imgLeft, Top:=imgTop + 2, Width:=-1, Height:=-1) .Height = Range(Adresse).Height * 4 - 4 End With End If   Next End Sub

---

Dans le principe ça fonctionne mais il y a un détail de poids que j'ai oublié de mentionner.
Les cellules recevant les images sont fusionnées (4 lignes fusionnées en hauteur).

C'est pourquoi j'ai rajouté

Code:

---

.Height = Range(Adresse).Height * 4 - 4

---

Cependant, il reste un soucis dans le calcul de "i".
En effet, Dans les fait i est incrémenté 1 par 1. Sauf que les cellules elles, faisant 4 lignes, correspondrait à un incrément de 4

Du coup j'ai des décalages qui se créé.

Sauriez vous comment gérer ce problème ?

Merci !


EDIT :

C'est bon c'est résolu ! Tout fonctionne !
Voici le code final :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

Sub importImage() Folder = ThisWorkbook.Path SubFolder = Folder & "\imgDisplateIMPORT\" For i = 5 To 2009 Step 4 FullName = SubFolder & Range("D" & i) & ".jpg" Adresse = "B" & i   imgTop = Range(Adresse).Top imgLeft = Range(Adresse).Left imgWidth = -1 imgHeight = -1     If Len(Dir(FullName)) > 0 Then   With ActiveSheet.Shapes.AddPicture(Filename:=FullName, linktofile:=msoFalse, _ savewithdocument:=msoCTrue, Left:=imgLeft, Top:=imgTop + 2, Width:=-1, Height:=-1) .Height = Range(Adresse).Height * 4 - 4 End With End If Next End Sub

---

Merci à tous pour vos pistes qui m'ont mené à la solution :)

Code:

---

For i = 5 To 2009 step 4

---