Macro copie image

Bonjour le forum,

Je dispose d'une macro qui me permet d'insérer des images dans une feuille Excel et dans un emplacement précis. Ces images sont redimensionnées en fonction de l'emplacement défini.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

Sub InsertionImage() Dim Emplacement As Range Dim Img As Object Dim ShapeObj As Shape   'Boucle pour supprimer l'ancienne image For Each ShapeObj In ActiveSheet.Shapes If ShapeObj.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete Next ShapeObj   If Application.Dialogs(xlDialogInsertPicture).Show Then 'Définit l'emplacement de l'image Set Emplacement = Range("B5:G30")   Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)   With Img.ShapeRange 'Nommer l'image insérée (Pour la supprimer plus facilement ensuite) .Name = "Cible" .LockAspectRatio = msoFalse .Left = Emplacement.Left .Top = Emplacement.Top .Height = Emplacement.Height .Width = Emplacement.Width End With   Else MsgBox "Insertion d'image interrompue." End If   End Sub

---

La macro fonctionne bien j'ai juste un petit soucis que je n'arrive pas à résoudre. Je voudrais définir l'emplacement de l'image en fonction d'une plage de cellule nommée c'est à dire par exemple remplacer :

Set Emplacement = Range("B5:G30") par Set Emplacement = Range("Courbe1").

Lorsque je fais cette modification, la macro fonctionne toujours, cependant, l'image insérée n'est pas redimensionnée correctement, elle est plus petite que ce qu'elle devrait être.

Avez-vous une idée d'où pourrait venir le problème et comment y remédier?

Je vous remercie d'avance ;)!