Insérer image dans une cellule [Résolu]

Signaler
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020
-
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020
-
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

Messages postés
13246
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 novembre 2020
743
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?
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

Bonjour et merci d'avoir pris le temps de me répondre.

Mes dossiers images sont des images de couverture de livre avec des formats différents : png, tiff, jpg, jpeg, etc.

Je souhaite récupérer ces images en fonction de l'auteur et du titre. J'ai donc des dossiers auteurs dans lesquels se trouvent mes images.
En colonne A, j'ai mis les auteurs et en B les titres. En C la formule concatener(chemin d'accès du dossier source ; auteur ; titre) me donne l'endroit où aller chercher l'image.

Mais voilà ce que j'obtiens la plupart du temps

D'ailleurs maintenant je n'obtiens plus que cette image.
Je pense que le problème vient du format de l'image.
Alors je me demandai s'il était possible dans ma macro de pouvoir insérer l'image sans se soucier du format.

Pour la deuxième problématique quand j'ouvre à nouveau le classeur un encart s'ouvre et me demande de sélectionner le fichier source.

Le but de tout ça est de créer une base données avec réfs et images pour envoyer à d'autres personnes pour en lire le contenu et bien entendu ils n'auront pas les images.

De plus comme les problèmes en amènent d'autres lorsque le fait un tri des auteurs par exemple les images ne suivent pas le tri. Pourtant ça fonctionne quand j'applique un filtre.

Bref. Plus j'avance et moins ça fonctionne ????

Encore merci !!!
Messages postés
13246
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 novembre 2020
743
pour le premier, veux-tu dire que tu voudrais ajouter une image, sans connaitre son extension?
pour le second, tu n'as pas répondu à ma question: as-tu le même soucis quand tu fais le travail à la main, sans macro?
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

Pour le premier, c'est ça. En C j'obtiens par exemple : /Users/ludwigbarrachin/Desktop/Ludwig/Images livres/Franck Thilliez/Rêver et je ne peut préciser l'extension car je ne la connais pas. Du moins il faudrait que j'aille vérifier à chaque image. Pour deux ou trois références ça ne poserai pas de problème mais pour des centaines c'est pas pareil. ????

Pour le deuxième, en effet si je le fait sans macro l'image s'affiche aussi sur un autre ordi. ????
Messages postés
13246
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 novembre 2020
743
pour le premier soucis, je pense qu'il faut modifier le vba pour qu'il aille chercher, pour chaque fichier, la bonne extension.

pour le second soucis, j'imagine que la macro ne fait pas la même chose qu'à la main. pour vérifier cela, peux-tu, pendant que tu fais le travail à la main, enregistrer une macro, pour découvrir la différence?
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

Voilà ce que j'obtiens en faisant l'enregistrement. Je vais refaire ma macro depuis cette base.
[https://www.commentcamarche.net/contents/446-fichier-sub Sub] Macro4()
'
' Macro4 Macro
'

'
    Range("D2").Select
    ActiveSheet.Pictures.Insert( _
        "/Users/ludwigbarrachin/Desktop/Ludwig/Images livres/Franck Thilliez/Angor1.jpeg" _
        ).Select
End Sub


Par contre pour mon premier problème je serai incapable de trouver la solution par moi-même.

PS : La série des "????" je voulais juste insérer des emoticons. ????
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

C'est une histoire de dingue.

Dès que j'utilise une macro que ce soit celle issue de l'enregistreur de macro ou la mienne, les images n'apparaissent plus une fois le fichier Excel transféré sur un autre ordi.

De plus les images s'affichent uniquement et uniquement si au préalable je les ai insérées manuellement. Je m'en suis rendu compte après avoir inséré manuellement l'image pour enregistrer la macro.

Pour ce test j'ai sélectionné une vingtaine d'images au format jpeg prises sur internet et dans ma colonne C j'ai ajouté l'extension ".jpeg" au chemin d'accès de l'image.

Dim Fichier As String
Dim ObjImg As Object
Dim Emplacement As Range
Dim Shp As Shape
Dim DerLg, Lg, Climg, Clad As Integer
Dim Titre, Chemin As String

Sub InsererImage()

'ligne départ pour la boucle
Lg = 2

'ligne de fin pour la boucle
DerLg = Cells(65536, 1).End(xlUp).Row

'colonne où insérer l'image
Climg = Sheets("Paramètres").Range("B7").Value

'colonne où trouver le chemin d'accès de l'image
Clad = Sheets("Paramètres").Range("B8").Value

Do While Lg <= DerLg

'mise en mémoire du chemin d'accès
Chemin = Cells(Lg, Clad).Value
    
'sélection de la cellule où insérer l'image
Cells(Lg, Climg).Select
    
    On Error Resume Next
        
    'dimensionner la cellule
    With Cells(Lg, Climg)
        .Select
        .RowHeight = Sheets("Paramètres").Range("B2").Value
        .ColumnWidth = Sheets("Paramètres").Range("B3").Value
    End With
    
    'insertion de l'image
    With ActiveSheet
        .Pictures.Insert(Chemin).Select
    End With
        
    'mis en forme de l'image
    Set Emplacement = ActiveCell
    Set ObjImg = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
    With ObjImg
        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.Left = Emplacement.Left
        .ShapeRange.Top = Emplacement.Top + 5
        .ShapeRange.Height = Emplacement.Height - 10
        .ShapeRange.Width = Emplacement.Width
        .Placement = xlMoveAndSize
    End With

Lg = Lg + 1

Loop

End Sub


Encore merci à toi et bonne soirée !
Messages postés
13246
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 novembre 2020
743 >
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

je lis que ceci serait préférable pour éviter le second problème.
ActiveSheet.Shapes.AddPicture _
     Filename:="C:\Temp\barcode.png"  _
     , LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue _
     , Left:=..., Top:=..., Width:=..., Height:=...
Messages postés
13246
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 novembre 2020
743
pour le premier problème, le plus facile serait de supposer qu'on peut prendre n'importe quel fichier ayant le nom recherché (hors extension).

si on peut supposer cela, je pense, sans l'avoir testé, qu'il suffit de faire ainsi:
Fichier = dir( cstr( Range("C" & Lg).Value ) + ".*" )
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

Bonjour à toi,

Je vois que la nuit t'a été de bon conseil. Tes solutions fonctionnent très bien. Je te remercie beaucoup je n'y serais pas arriver sans ton aide !

Voici mon, disons plutôt, notre code pour ceux que ça pourrait intéresser :

Dim Fichier As String
Dim Emplacement As Range
Dim Shp As Shape
Dim DerLg, Lg, Climg, Clad, Claut, Clti As Integer
Dim Chemin As String

Sub InsererImage()

'Efface les images déjà existantes
For Each Shp In ActiveSheet.Shapes
   Shp.Delete
Next Shp

'ligne départ pour la boucle
Lg = 2

'ligne de fin pour la boucle
DerLg = Cells(65536, 1).End(xlUp).Row

'colonne où insérer l'image
Climg = Sheets("Paramètres").Range("B7").Value

'colonne où trouver le chemin d'accès de l'image, de l'auteur et du titre
Clad = Sheets("Paramètres").Range("B8").Value
Claut = Sheets("Paramètres").Range("B5").Value
Clti = Sheets("Paramètres").Range("B6").Value

Do While Lg <= DerLg

'mise en mémoire du chemin d'accès, m'évite de mettre une formule en C
Fichier = Dir(CStr(Sheets("Paramètres").Range("B1").Value & "/" & Sheets("Liste").Cells(Lg, Claut) & "/" & Sheets("Liste").Cells(Lg, Clti)) + ".*")
Chemin = Sheets("Paramètres").Range("B1").Value & "/" & Sheets("Liste").Cells(Lg, Claut) & "/" & Fichier

'sélection de la cellule où insérer l'image
Cells(Lg, Climg).Select
    
    On Error Resume Next
        
    'dimensionner la cellule, les dimensions sont dans la feuille paramètres
    With Cells(Lg, Climg)
        .Select
        .RowHeight = Sheets("Paramètres").Range("B2").Value
        .ColumnWidth = Sheets("Paramètres").Range("B3").Value
    End With
    
    'insertion et mis en forme de l'image
    Set Emplacement = ActiveCell
    
    ActiveSheet.Shapes.AddPicture FileName:=Chemin, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoCTrue, _
        Left:=Emplacement.Left + 2, _
        Top:=Emplacement.Top + 5, _
        Width:=Emplacement.Width - 4, _
        Height:=Emplacement.Height - 10

Lg = Lg + 1

Loop

    'j'applique à toutes les images le déplacement et le dimensionnement avec la cellule
    For Each Shp In ActiveSheet.Shapes
        Shp.Placement = xlMoveAndSize
    Next Shp

End Sub


Enfin, pour que le tri puisse se faire correctement, en plus d'activer le "déplacer et dimensionner avec la cellule" il est impératif que l'image ne dépasse pas de la cellule où elle a été insérée.

Encore merci pour ton aide et bon dimanche.

Cdt; Ludwig
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

Oups ! je me suis un peu avancé.

J'ai souhaité ajouter d'autres livres et un message d'erreur s'affiche ="Une erreur s'est produite lors de l'importation de ce fichier. /Users/ludwigbarrachin/Desktop/Ludwig/Images livres/Dan Brown/Da Vinci code.jpeg".

Ce qui est bizarre c'est que si je insère l'image manuellement, que je l'efface et que je lance la macro alors l'image s'affichera correctement.

Qu'est-ce qui cloche ?

Encore merci.
Messages postés
13246
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 novembre 2020
743
qu'est-ce qui est différent entre ceux qui fonctionnent et ceux qui ne fonctionnent pas?
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

Lorsque la macro arrive sur la ligne 49 "ActiveSheet.Shapes.AddPicture FileName:=Chemin..." ce message d'alerte s'affiche.



Sur la feuille Excel l'image ne s'affiche pas, la cellule reste vide et passe à la suivante.

L'image s'affichera que si elle a été, à un moment donné, insérée manuellement (Sans macro).
Je ne comprends pas la raison !
Messages postés
13246
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 novembre 2020
743
rien de spécial dans le nom des fichiers, leur localisation?
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

Non rien de spécial, du moins rien qui me saute aux yeux !
Messages postés
13246
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 novembre 2020
743
et quand tu réessaies, la même erreur revient sur le même fichier?
si tu supprimes cette ligne dans le fichier, quelle sera la prochaine erreur?

supprime, temporairement au moins, la ligne de code
on error resume next
, cela peut cacher des erreurs à corriger.
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

Oui j'ai toujours la même erreur sur les mêmes images. Si je supprime la ligne où il y a la première erreur, l'erreur se répercute à la ligne suivante et ainsi de suite.

J'ai bloqué on error resume next et "une erreur d'exécution 1004" apparait. "Erreur définie par l'application ou par l'objet".
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

Pardon l'erreur renvoie à la ligne 49 de la macro :"ActiveSheet.Shapes.AddPicture FileName:=Chemin, "
Messages postés
13246
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 novembre 2020
743 >
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

donc cela fonctionne pour certains livres, et pas pour d'autres?
cela fonctionne pour les anciens, pas pour les nouveaux?
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

C'est ça. Si je ne fais pas, une première fois, l'insertion en passant le menu : insertion/illustrations/images/Image à partir d'un fichier. La macro ne fonctionnera pas pour une image qui n'a jamais été insérée de cette manière. Je ne comprends absolument pas pourquoi. D'autant plus qu'ensuite la macro fait exactement le travail.

Peut-être que Chemin ne doit pas être déclaré en string ?
Messages postés
13246
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
23 novembre 2020
743
tes chemins sont bizarres, il manque le disque au début.
qu'as-tu comme chemin si tu visualises un dossier d'image dans l'explorateur de fichiers, puis clique à droite du nom dans la barre du haut?
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

Je suis sur mac et j'utilise microsoft 365. J'ai obtenu le chemin d'accès dans les infos du fichier. Lorsque j'enregistre la macro j'obtiens le même chemin.
Messages postés
48
Date d'inscription
mercredi 1 août 2018
Statut
Membre
Dernière intervention
15 septembre 2020

Bonjour,

Je crois que je viens de trouver la solution.

C'est le renforcement de la sécurité sous Mac OS X qui est à l'origine de ce problème. Il faut que le dossier, dans mon cas le dossier "Images livres", soit enregistré dans la bibliothèque et non pas, comme je l'avais fait, enregistré sur le bureau.

Encore merci pour toute ton aide. C'est très appréciable !!!

Je te souhaite une très bonne journée et à très bientôt.

Cdt, Ludwig