Insérer image dans une cellule

Résolu/Fermé
Louloude74 Messages postés 62 Date d'inscription mercredi 1 août 2018 Statut Membre Dernière intervention 17 avril 2024 - 8 mai 2020 à 19:59
Louloude74 Messages postés 62 Date d'inscription mercredi 1 août 2018 Statut Membre Dernière intervention 17 avril 2024 - 11 mai 2020 à 16:13
Bonjour tout le monde,

J'espère que ça va pour vous et que le confinement ne vous pèse pas trop.

Je me retrouve une fois de plus confronter à un mur.

J'ai trouvé des pistes de macro en recherchant à droite à gauche mais j'ai du mal à me les approprier.

Je souhaite insérer des images dans une cellule en fonction de deux critères : Auteur et titre.

Pour cela j'ai dans la colonne A les auteurs et dans la colonne B les titres des livres. En C j'ai mis une formulaire avec concatener pour afficher l'adresse de l'image et cela me donne : /Users/ludwigbarrachin/Desktop/Ludwig/Images livres/Franck Thilliez/Rever

Ma macro fait une boucle et insère les image en D.
Première problématique : J'ai plusieurs formats d'image, jpeg, jpg, png, gif...
Deuxième problématique : Le fichier sera envoyé à d'autres personnes. Les images doivent être stockées dans la feuille.

Dim Fichier As String
Dim ObjImg As Object
Dim Emplacement As Range
Dim Shp As Shape
Dim DerLg, Lg As Integer

Sub InsererImage()

DerLg = Range("C65536").End(xlUp).Row
Lg = 2

Do While Lg <= DerLg

Fichier = Range("C" & Lg).Value

Set ObjImg = ActiveSheet.Pictures.Insert(Fichier)

With Range("D" & Lg)
    .Select
    .RowHeight = Sheets("Paramètres").Range("B2").Value
    .ColumnWidth = Sheets("Paramètres").Range("B3").Value
End With

Set Emplacement = ActiveCell
Set ObjImg = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
With ObjImg.ShapeRange
    .LockAspectRatio = msoFalse
    .Left = Emplacement.Left
    .Top = Emplacement.Top + 5
    .Height = Emplacement.Height - 10
    .Width = Emplacement.Width
End With

  For Each Shp In ActiveSheet.Shapes
    Shp.Placement = xlMoveAndSize
  Next Shp
  
  Lg = Lg + 1
  
Loop

End Sub


Je vous souhaite une bonne soirée et à très vite.

Merci.

Ludwig

12 réponses

yg_be Messages postés 23342 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 21 novembre 2024 Ambassadeur 1 551
9 mai 2020 à 12:25
bonjour,
peux-tu décrire ton premier problème?
en ce qui concerne le second, peux-tu l'éviter quand tu fais le travail sans macro?
0