Bonjour à tous,
je viens de trouver sur ce forum une macro me permettant d'inserrer un image.
Mais je ne parviens pas à la mette en appliquation dans mon classeur,
j'ai bien copier la macro, mais elle ne fonction pas, elle m'enlève des boutons, elle place les photos n'importe où et pas à la bonne dimention.
Si quelqu'un pouvait m'aider?
merci d'avance.
La macro est celle-ci:
Option Explicit
Sub InsertionImage()
Dim Emplacement As Range
Dim image As Object
Dim ShapeObj As Object
On Error GoTo fin:
For Each ShapeObj In ActiveSheet.DrawingObjects ' boucle pour supprimer ancienne image
If ShapeObj.Name = "cible" Then ActiveSheet.Shapes("cible").Delete
Next ShapeObj
Application.Dialogs(xlDialogInsertPicture).Show
Set Emplacement = Range("D2:E8")
Set image = ActiveSheet.DrawingObjects(2) 'adapter selon nombre total de shapes dans feuille
With image.ShapeRange
.Name = "cible" ' nommer l'image insérée ( pour la supprimer plus facilement ensuite )
.LockAspectRatio = msoFalse
.Left = Emplacement.Left
.Top = Emplacement.Top
.Height = Emplacement.Height
.Width = Emplacement.Width
End With
Exit Sub
fin:
If Err = 1004 Then MsgBox "Insertion d'image interrompue . "
End Sub
je viens de trouver sur ce forum une macro me permettant d'inserrer un image.
Mais je ne parviens pas à la mette en appliquation dans mon classeur,
j'ai bien copier la macro, mais elle ne fonction pas, elle m'enlève des boutons, elle place les photos n'importe où et pas à la bonne dimention.
Si quelqu'un pouvait m'aider?
merci d'avance.
La macro est celle-ci:
Option Explicit
Sub InsertionImage()
Dim Emplacement As Range
Dim image As Object
Dim ShapeObj As Object
On Error GoTo fin:
For Each ShapeObj In ActiveSheet.DrawingObjects ' boucle pour supprimer ancienne image
If ShapeObj.Name = "cible" Then ActiveSheet.Shapes("cible").Delete
Next ShapeObj
Application.Dialogs(xlDialogInsertPicture).Show
Set Emplacement = Range("D2:E8")
Set image = ActiveSheet.DrawingObjects(2) 'adapter selon nombre total de shapes dans feuille
With image.ShapeRange
.Name = "cible" ' nommer l'image insérée ( pour la supprimer plus facilement ensuite )
.LockAspectRatio = msoFalse
.Left = Emplacement.Left
.Top = Emplacement.Top
.Height = Emplacement.Height
.Width = Emplacement.Width
End With
Exit Sub
fin:
If Err = 1004 Then MsgBox "Insertion d'image interrompue . "
End Sub
Pièces jointes
Dernière édition:
