Insertion image à la taille d'une cellule

Un petit up!

Hello,

Mea culpa, je t'avais complètement oublié ! Tu as bien fait d'up.

Essaie cette macro et dis moi si le problème des dimensions te va :

Sub insere_image()
Dim ficimg As String, Ad As String
Ad = Selection.Address
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
If ficimg = "Faux" Then Exit Sub
ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
With Selection.ShapeRange
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
'Pas besoin, c'est fait automatiquement sur la sélection :
'.Top = Range(Ad).Top ' haut de la cellule
'.Left = Range(Ad).Left ' gauche de la cellule
.Height = Range(Ad).Height ' hauteur des cellules fusionnées
.Width = Range(Ad).Width ' largeur des cellules fusionnées
End With
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
End Sub

Si oui j'te refais le tout et on sera good

Salut! Y'a pas de mal. Je pense pas que résoudre mon problème soit ta priorité absolue

En tout cas j'ai test ton code et l'image s'adapte bien en hauteur et en largeur qu'elle soit plus petite ou plus grande

Un seul truc que j'aimerai rajouté si ça ne te dérange pas!

Des fois j'ai déjà une image dans ma cellule fusionnée mais je dois la remplacer.

Peut-on rajouter une ligne dans le code pour que si je sélectionne l'image [qui sera déjà adaptée grâce à ta macro] (et non pas ma cellule) et bien la macro fonctionne aussi?

Si c'est pas faisable ou trop compliqué tant pis, je suis pointilleux pour pas avoir à revenir en trombe plus tard quand tu aura plus le sujet en tête

Voila en tout cas merci!!!!

Autant pour moi il y a une énorme erreur!

Quand j'insère une image normalement avec Insertion > Image et que je sauvegarde l'image reste dans mon fichier et ce même si je supprime l'image que je suis allé cherché sur internet.

CEPENDANT avec ta macro, si j'insère l'image via celle ci et que j'ai le malheur de supprimer l'image que je suis allé chercher sur internet de mes fichier et bien j'ai droit à ça:

Une idée du pourquoi de la chose? Moi en tout cas j'aimerai que mon image reste dans mon fichier même si je l'intègre via ta macro et que je supprime l'image "source" de mes fichiers.

PS: J'ai eu le droit il n'y a pas longtemps à cela sur mes plus de 700 feuilles sans raison, j'ai du refaire toute mes images manuellement... A ce moment cela n'avais rien a voir avec ta macro donc cela me fait un peu peur

Sub insere_image()
Dim ficimg As String, Ad As String
Ad = Selection.Address
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
If ficimg = "Faux" Then Exit Sub
Set Image = ActiveSheet.Shapes.AddPicture(ficimg, False, True, ActiveCell.Left, ActiveCell.Top, Range(Ad).Width, Range(Ad).Height)
With Image
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
.Placement = xlMoveAndSize
End With
End Sub

Essaie donc ceci

Apparemment c'est ok.

L'image ne disparait plus.

Encore une fois merci et je te tiens au jus si jamais il y a d'autres soucis mais ça devrait aller!

Pas de soucis, le problème venait de "Pictures.Insert" qui insère les images en linked, alors que Shapes.addpicture permet l'insertion en embbed.

Pour la requête "bonus", quitte à cliquer sur l'image précédente, autant appuyer sur "sup" en même temps et la cellule redeviendra visible (brouillon mais pas envie de me casser la tête pour 1 touche) Et ça se trouve, en l'état, tu peux insérer une image par-dessus l'image précédente

Bonsoir Soumzoum! Le forum!

Je me permet de revenir à la charge pour la macro que tu m'a donné

En effet celle-ci fonctionne très bien MAIS (car il y a un mais) je ne suis "autorisé" qu'a inséré des images au format jpg.

Si j'ai des images qui sont au format png, bmp ou autre et bien je suis embêté.

Je suppose qu'il est possible d'ajouter des format au code mais je ne sais comment faire alors j'aimerai, si tu as le temps, que tu m'indique comment faire!

Je te redonne ton code!

    Sub insere_image()
    Dim ficimg As String, Ad As String
    Ad = Selection.Address
    ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
    If ficimg = "Faux" Then Exit Sub
    Set Image = ActiveSheet.Shapes.AddPicture(ficimg, False, True, ActiveCell.Left, ActiveCell.Top, Range(Ad).Width, Range(Ad).Height)
    With Image
    .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
    .Placement = xlMoveAndSize
    End With
    End Sub

A très vite et bonne soirée!

je suis sur mon téléphone donc c'est difficile de te faire des modifs en temps réel

Modifie ou supprime le premier argument de GetOpenFilename

Bonjour,

Modification faite, changement approuvé

Encore une fois merci! Bonne journée.