Insérer plusieurs photos et les redimensionner automatiquement

Bonjour,

Je souhaitais vous solliciter par rapport à l’une de mes problématiques en entreprise.

Pour remettre dans le contexte, nous générons des ordres de fabrication via un fichier EXCEL. Ce fichier va chercher les données de fabrication (notamment nomenclatures) dans notre système de gestion commerciale.
Afin de rendre plus « user friendly » le document distribué, mais aussi d’apporter tout de suite une information visuelle, je souhaite faire afficher une photo de l’article que les opérateurs vont devoir fabriquer.

Ces photos, au format JPEG, sont rangées dans un dossier unique nommé « Images Produits » et porte comme nom le numéro de référence de l’article. Dans une cellule du fichier Excel je vais afficher automatiquement le chemin menant à la photo du produit concerné, ex :
Z:\Images Produits\7018051.jpg

Ensuite je clique sur un bouton pour lancer une macro qui doit aller chercher la photo voulue puis l’insérer à un endroit précis du document et mettre en forme la dimension de la photo afin que le document soit directement imprimable. J’ai donc le programme suivant :

Code:

---

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

Sub TEST_PHOTO()   'sélectionner la cellule qui contient le lien vers la photo Range("H42:J45").Select   'insérer la photo du lien ActiveSheet.Pictures.Insert(ActiveCell.Value).Select Selection.Placement = xlMoveAndSize   'redimensionner la photo With ActiveSheet ActiveSheet.Shapes.Range(Array("Picture 1")).Left = Range("H42:J45").Left ActiveSheet.Shapes.Range(Array("Picture 1")).Top = Range("H42:J45").Top ActiveSheet.Shapes.Range(Array("Picture 1")).LockAspectRatio = msoFalse ActiveSheet.Shapes.Range(Array("Picture 1")).Height = Range("H42:J45").Height ActiveSheet.Shapes.Range(Array("Picture 1")).Width = Range("H42:J45").Width End With   End Sub

---

Le programme fonctionne bien mais uniquement sur le premier Ordre de fabrication. En effet la photo s’appelle « Picture 1 » dans mon programme. A chaque insertion de photo Excel incrémente leur nom, donc le sphotos deviennent picture 1, puis picture 3 etc. Or dans mon code, le nom de la photo reste fixe… Comment pourrais-je faire ?

Bien à vous

essaye en remplaçant le "with Activesheet" par un "with selection" puisque à l'étape précédente ton image est sélectionnée.

bonjour,

Citation:

---

With ActiveSheet
ActiveSheet.Shapes.Range(Array("Picture 1")).Left = Range("H42:J45").Left
ActiveSheet.Shapes.Range(Array("Picture 1")).Top = Range("H42:J45").Top
ActiveSheet.Shapes.Range(Array("Picture 1")).LockAspectRatio = msoFalse
ActiveSheet.Shapes.Range(Array("Picture 1")).Height = Range("H42:J45").Height
ActiveSheet.Shapes.Range(Array("Picture 1")).Width = Range("H42:J45").Width
End With

---

on utilise With pour "éclaircir" le code, pour ne pas "répéter",...

Code:

---

1 2 3 4 5 6 7 8

With ActiveSheet.Shapes.Range(Array("Picture 1")) .Left = Range("H42:J45").Left .Top = Range("H42:J45").Top .LockAspectRatio = msoFalse .Height = Range("H42:J45").Height .Width = Range("H42:J45").Width End With

---

@+JP

Et pourquoi pas ça ?

Code:

---

1 2 3 4 5 6 7 8

With selection .Left = Range("H42:J45").Left .Top = Range("H42:J45").Top .LockAspectRatio = msoFalse .Height = Range("H42:J45").Height .Width = Range("H42:J45").Width End With

---

bonjour,

et pourquoi pas ? :mouarf:

Code:

---

1 2 3 4 5 6 7 8 9 10 11

With selection   .Placement = xlMoveAndSize   .Left = Range("H42:J45").Left .Top = Range("H42:J45").Top .LockAspectRatio = msoFalse .Height = Range("H42:J45").Height .Width = Range("H42:J45").Width End With

---

@+JP

Bonjour à vous deux,

Je vous remercie vivement pour votre aide, car effectivement ce code avec "With selection" fonctionne superbement ! Et en plus il s'est "éclaircit" :)

Vivement Lundi que je puisse faire joujou avec mes jolis OF........

Bon WE