Insertion image dans cellule

Bonjour,

Je cherche à insérer une image provenant d'un lien "variable" dans une cellule prédéfinie. (Cette cellule est un rassemblement de cellules provenant de l'action "Fusionner et centrer")
Je souhaite que la photo se redimensionne dans la longueur, largeur et hauteur de la cellule.

Pourriez vous m'aider s'il vous plait.

Bonne journée.

Sub Insertion_image()

Dim chemin As String
Dim NomImage As String
Dim Extension As String

chemin = "C:\Users\alexa\OneDrive\Images\Plans circuits\"
NomImage = Worksheets("Paramétrage").Range("B4")
Extension = ".png"

CheminImage = chemin & NomImage & Extension

With Feuil1

    With .Pictures.Insert(CheminImage)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Height = 50
            .Name = NomImage
        End With
    End With
    With .Shapes(NomImage)
        .Left = Feuil1.Range("M1").Left
        .Top = Feuil1.Range("M1").Top
        .IncrementLeft 8
        .IncrementTop 3
    End With

End With

End Sub

Le problème est qu'actuellement le code s’arrête à la ligne : et m'affiche "Erreur d’exécution "424" : Objet requis"

With .Pictures.Insert(CheminImage)

Bonjour,

Bizarre, j'ai cherché un peu et je n'ai trouvé aucune trace de la propriété/objet Pictures... Je propose d'utiliser Shapes.addpicture à la place.

Pouvez-vous essayer ainsi :

Sub Insertion_image()

Dim chemin As String
Dim NomImage As String
Dim Extension As String

chemin = "C:\Users\alexa\OneDrive\Images\Plans circuits\"
NomImage = Worksheets("Paramétrage").Range("B4")
Extension = ".png"

CheminImage = chemin & NomImage & Extension

With Feuil1
    With .shapes.addpicture(filename:=CheminImage, linktofile:=msofalse, savewithdocument:=msotrue, _
        left:=.Range("M1").Left, top:=.Range("M1").Top, width:=50, height:=50)
            .Name = NomImage
            .IncrementLeft 8
            .IncrementTop 3
    End With
End With

End Sub

Il n'y a que la largeur à arranger, le reste provient de votre précédent code.

Cdlt,

Bonjour,

Merci pour votre réponse. Ça marche ! Pour que cela fonctionne j'ai aussi du remplacer le "With Feuil1" par "With Worksheets"Test plan""

Bonne journée

Bonjour,

Génial ! Merci pour ce retour et très bonne journée à vous aussi !

Cdlt,