Discussion :

[FredW]

Bonjour à tous,

J'avais réalisé un petit code VBA pour importer une image et la dimensionner à la taille d'une cellule. Tout a très fonctionné jusqu'à que je passe à Office 2019 (avant j'étais sur office 2007). Maintenant, mon code ne "colle" plus l'image mais conserve un lien. Du coup, si je déplace ou supprime l'image de mon PC alors l'image disparait également de mon classeur.

J'ai chercher longtemps sur internet mais je n'ai pas trouvé de réponse à mon problème.

Merci d'avance pour votre aide !!!

Frederic

Voici mon code :

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub AjoutImage() 'ajouter image
Dim ficimg As String, Ad As String, ImageName As String
Dim CellH As Long, CellW As Long
Dim ShapeObj As Object
 
    ActiveSheet.Range("CellImage").Select
    Ad = Selection.Address
    CellH = Selection.Height
    CellW = Selection.Width
    ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix de l'image
    If ficimg = "Faux" Then ActiveSheet.Protect Password:="xxxxx", DrawingObjects:=False, Contents:=True, AllowFormattingCells:=True: Exit Sub
    ActiveSheet.Pictures.Insert(ficimg).Select ' insertion de l'image
    With Selection.ShapeRange
      ImageName = ActiveSheet.Name
      .Name = ImageName
      .LockAspectRatio = False ' ne conserve pas la proportions d'origine
      .Top = Range(Ad).Top + 0.5 ' haut de la cellule
      .Left = Range(Ad).Left + 0.5 ' gauche de la cellule
      .Height = CellH - 0.5
      .Width = CellW - 0.5
      .SoftEdge.Type = msoSoftEdgeType4
    End With
    With Selection
        .Placement = xlMoveAndSize
        .PrintObject = True
    End With
    Application.SendKeys "AC~", True
    Application.CommandBars.ExecuteMso "PicturesCompress"

[marot_r]

Bonjour.

Apparemment tu n'es pas seul.

Ici une solution selon l'auteur.

VBA Insert Picture Bug
https://www.mrexcel.com/excel-tips/v...t-picture-bug/

A+

[Menhir]

Une petite remarque liminaire : je te déconseille l'utilisation de Select qui sont toujours ambigus.
Il est préférable de passer par des variables objets pour désigner ton image, en récupérant sa référence par la valeur renvoyée par la méthode qui sert à les insérer.

Ca concerne aussi la cellule destination.
Tu devrais remplacer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Dim Ad As String
 
    ActiveSheet.Range("CellImage").Select
    Ad = Selection.Address
    CellH = Selection.Height
    CellW = Selection.Width

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim Ad As Range
Set Ad =ActiveSheet.Range("CellImage")
    CellH = Ad.Height
    CellW = Ad.Width

Pour ce qui est du chargement de ton image, essaye ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Dim MonImage As Shape
Set MonImage = ActiveSheet.Shapes.AddPicture ficimg, False, True, Ad.Top, Ad.Left, Ad.Height, Ad.Widht

Ce code remplace aussi une partie de ce qui se trouve dans le With en dessous.

Lire ça : https://docs.microsoft.com/fr-fr/off...ectedfrom=MSDN

[FredW]

Merci Marot_r, merci Menhir, vos remarques m'ont été d'une grand aide, j'ai pu résoudre mon problème grâce à vous.