Microsoft 365 Macro Insertion image dans cellule

l.et.lilou

XLDnaute Junior
Bonjour à tous,

J'ai besoin de votre aide (de nouveau haha).
Je pense que la macro est simple mais je n'y arrive pas...

Je vous joins mon fichier pour que ca soit plus claire mais j'aimerais simplement :
- Supprimer la précédente image ajoutée dans la cellule
- Ajouter la nouvelle image dans la cellule.

1) Ma première difficulté c'est que je suis obligée de placer l'image dans la cellule pour pouvoir grouper mes lignes avec l'image comprise
2) Ma deuxième difficulté c'est que l'image devient flou ou mal ajustée selon ses dimensions - pensez vous que c'est possible de la faire ajuster automatiquement ?

Je vous envoi mon fichier avec un test d'image...
Ma macro est dedans, je vous la joins ici aussi :

Sub AjouterImage()
Dim cheminImage As String
Dim img As Shape
Set img = ActiveSheet.Shapes(cheminImage)
Dim celluleCible As Range
Set celluleCible = ActiveSheet.Range("P236")

Range("P236").Select
Selection.ClearContents

cheminImage = Application.GetOpenFilename(FileFilter:="Images (*.jpg; *.jpeg; *.png; *.gif), *.jpg; *.jpeg; *.png; *.gif")

If cheminImage <> "Faux" Then
ActiveSheet.Pictures.Insert(cheminImage).Select
With img
.LockAspectRatio = msoFalse
.Width = celluleCible.Width
.Height = celluleCible.Height
.Top = celluleCible.Top
.Left = celluleCible.Left
End With
End If
End Sub


Merci de votre aide 🤗
 

Pièces jointes

  • Image.xlsm
    73.1 KB · Affichages: 11

Dranreb

XLDnaute Barbatruc
Bonjour.
Exemple de code, alors :
VB:
Option Explicit
Sub AjouterImage()
   Dim CheminImage, Img As MSForms.Image, OOt As OLEObject, Rng As Range
   On Error Resume Next
   CheminImage = Application.GetOpenFilename(FileFilter:="Images (*.jpg; *.jpeg; *.gif), *.jpg; *.jpeg; *.gif")
   If VarType(CheminImage) <> vbString Then Exit Sub
   Set OOt = ActiveSheet.OLEObjects("Image")
   If Err Then
      Set Rng = ActiveSheet.Range("P236").MergeArea
      Set OOt = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
        DisplayAsIcon:=False, Left:=Rng.Left, Top:=Rng.Top, Width:=Rng.Width, Height:=Rng.Width)
      OOt.Name = "Image"
      End If
   Set Img = OOt.Object
   Img.PictureSizeMode = fmPictureSizeModeZoom
   Img.Picture = LoadPicture(CheminImage)
   End Sub
 

Discussions similaires

Réponses
1
Affichages
359
Compte Supprimé 979
C

Statistiques des forums

Discussions
313 285
Messages
2 096 819
Membres
106 755
dernier inscrit
riviere gabriel