inserer une image selon la valeur du champ

[Hus]

Bonjour à tous !

Je suis nouveau sur le forum. Peut être qu'il a déjà été traité simplement je le repose :

Je dispose de :

- Feuille Excel contenant des lignes de produits identifiées chacune par un code
- Un répertoire contenant des images nommeés par leur code produit.gif

Je souhaiterai créer une colonne qui afficherait automatiquement les l'image associée à chaque ligne produit.

Exemple

Image Code Nom
10 Cafetière phillips

Affichage de l'image automatique dont le nom est 10.gif

Merci d'avance
Hus

 

[john]

Salut,

Voici un petit programme qui pourrai t'aider.
ci-dessous la procédure pour lire les fichiers qui se trouve dans un répertoire, dans mon exemple c:\\images\\ ATTENTION une fois que j'ai posté ce programme les backslashes n'apparraissent plus, donc ne pas oublier de les mettre derrière le c: et à la fin du chemin (dans mon exemple mettre le backslashe derrière images

Les deux procédures sont à mettre dans un module vba (pour ceux qui ne savent pas

Private Sub lit_fichier()
Dim x As Integer, nbFichiers As Integer
Dim Tableau() As String
Dim direction
Dim chemin

chemin = 'C:\\images\\' 'ici c'est le répertoire qui contient les images
'**************************************************************************************
'lister les fichiers du repertoire
direction = Dir(chemin & '\\*.*')
Do While Len(direction) > 0
nbFichiers = nbFichiers + 1
ReDim Preserve Tableau(1 To nbFichiers)
Tableau(nbFichiers) = direction
direction = Dir()
Loop
'**************************************************************************************
If nbFichiers > 0 Then
For x = 1 To nbFichiers
Range('A' & x).Select
AjoutImage (chemin & Tableau(x)) 'j'appelle la procédure pour ajouter l'image à la cellule active
Next x
End If
End Sub

ci-dessous la procédure qui permet d'ajouter les images en commentaire à la cellule active

Sub AjoutImage(Picture)
Dim Image As Variant
'on vérifie si la cellule contient un commentaire
Set Image = ActiveCell.Comment
If Not Image Is Nothing Then ActiveCell.Comment.Delete
Set Image = Nothing
'on insère l'image sélectionnée
With ActiveCell
.AddComment
.Comment.Visible = False
.Comment.Shape.Fill.Transparency = 0#
.Comment.Shape.Fill.UserPicture Picture
End With

End Sub

Voilà j'espère que ça pourra t'aider et qui sais ... peut être que ça servira à quelqu'un du forum, en tout cas pour ma part j'ai chercher longtemps pour pouvoir arriver à faire ça !!!

Bonne soirée à tous.

John :woohoo:

Message édité par: john, à: 09/12/2005 00:18

Message édité par: john, à: 09/12/2005 00:20

Message édité par: john, à: 09/12/2005 00:35

 

[Adelin2]

Re : Re:inserer une image selon la valeur du champ

Bjr au risque d'avoir l'air bête lol je ne vois vraiment pas comment faire, faux dire que je suis plus que novice en Excel pourtant ce que tu expliques est bien ce que je voudrai dans ma base de données est il possible de créer la formule puis de faire des copier-coller si je trouve bien sûr quelqu'un qui peu déjà me faire un exemple ?

Salut,

Voici un petit programme qui pourrai t'aider.
ci-dessous la procédure pour lire les fichiers qui se trouve dans un répertoire, dans mon exemple c:\\images\\ ATTENTION une fois que j'ai posté ce programme les backslashes n'apparraissent plus, donc ne pas oublier de les mettre derrière le c: et à la fin du chemin (dans mon exemple mettre le backslashe derrière images

Les deux procédures sont à mettre dans un module vba (pour ceux qui ne savent pas

Private Sub lit_fichier()
Dim x As Integer, nbFichiers As Integer
Dim Tableau() As String
Dim direction
Dim chemin

chemin = 'C:\\images\\' 'ici c'est le répertoire qui contient les images
'**************************************************************************************
'lister les fichiers du repertoire
direction = Dir(chemin & '\\*.*')
Do While Len(direction) > 0
nbFichiers = nbFichiers + 1
ReDim Preserve Tableau(1 To nbFichiers)
Tableau(nbFichiers) = direction
direction = Dir()
Loop
'**************************************************************************************
If nbFichiers > 0 Then
For x = 1 To nbFichiers
Range('A' & x).Select
AjoutImage (chemin & Tableau(x)) 'j'appelle la procédure pour ajouter l'image à la cellule active
Next x
End If
End Sub

ci-dessous la procédure qui permet d'ajouter les images en commentaire à la cellule active

Sub AjoutImage(Picture)
Dim Image As Variant
'on vérifie si la cellule contient un commentaire
Set Image = ActiveCell.Comment
If Not Image Is Nothing Then ActiveCell.Comment.Delete
Set Image = Nothing
'on insère l'image sélectionnée
With ActiveCell
.AddComment
.Comment.Visible = False
.Comment.Shape.Fill.Transparency = 0#
.Comment.Shape.Fill.UserPicture Picture
End With

End Sub

Voilà j'espère que ça pourra t'aider et qui sais ... peut être que ça servira à quelqu'un du forum, en tout cas pour ma part j'ai chercher longtemps pour pouvoir arriver à faire ça !!!

Bonne soirée à tous.

John :woohoo:

Message édité par: john, à: 09/12/2005 00:18

Message édité par: john, à: 09/12/2005 00:20

Message édité par: john, à: 09/12/2005 00:35

 

[maxis6582]

Re : inserer une image selon la valeur du champ

Bonjour a tous...

Je viens de trouver ce post et c'est éxactement ce que je dois faire mais j'ai beau chercher à metre en place ce programme depuis ce matin je n'arrive pas... Est-ce que quelqu'un peux m'aiguiller sur la maniere de proceder avec excel 2007?

merci d'avance

 

[Hulk]

Re : inserer une image selon la valeur du champ

Hello,

Voici une autre méthode.

Les images doivent se nommer exactement comme les cellules en colonne A.
Les images doivent se trouver dans le même répertoire que le fichier.

Prenez le fichier ici.

Cdt, Hulk.

 

[maxis6582]

Re : inserer une image selon la valeur du champ

merci c'est exactement ca!!!
mais est ce qu'il y aurai la possibilité de modifier le code pour que ca affiche simplement si il y a une image qui correspond ou si il n'y en a pas car j'ai 7000 lignes est c'est vraiment trop lourd...
voici le code actuel :

Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error Resume Next
    
    Dim Noms As Range
    Dim x As Range
    Dim s As Shape

    For Each s In ActiveSheet.Shapes
        If s.Type = msoPicture Then s.Delete
    Next s
      
    Set Noms = Range("A2:A10000")
    Set x = Range("B2:B10000")
  
    For Each Noms In x
        ActiveSheet.Shapes.AddPicture Filename:=ThisWorkbook.Path _
        & "\" & Noms.Offset(0, -1).Value & ".jpg", _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, _
        Left:=Noms.Left, _
        Top:=Noms.Top, _
        Width:=Noms.Width, _
        Height:=Noms.RowHeight
    Next Noms
    
End Sub

Merci d'avance

 

[Hulk]

Re : inserer une image selon la valeur du champ

Re,

Vois si ça te va... Si j'ai bien compris.

Ici.

Bonne nuit.

Hulk.

 

[MJ13]

Re : inserer une image selon la valeur du champ

Bonjour à tous

car j'ai 7000 lignes est c'est vraiment trop lourd

Le mieux est d'utiliser les macros de MichelXLD que je salue (faire une recherche sur XLD ou sur le net) en utilisant la dll Wiaaut.dll.

 

[BOISGONTIER]

Re : inserer une image selon la valeur du champ

Bonjour,

Les images et shapes

Function AfficheImage(NomImage, Optional rep As String)
  Application.Volatile
  If IsMissing(rep) Then rep = ThisWorkbook.Path & "\"
    Set adr = Application.Caller
    Set adr2 = Range(adr.Address).MergeArea
    temp = NomImage & "_" & adr.Address
    Existe = False
    For Each s In adr.Worksheet.Shapes
      If s.Name = temp Then Existe = True
    Next s
    If Not Existe Then
      For Each k In adr.Worksheet.Shapes
        P = InStr(k.Name, "_")
        If Mid(k.Name, P + 1) = adr.Address Then k.Delete
      Next k
      Set s = adr.Worksheet.Shapes.AddPicture(rep & NomImage, True, True, adr.Left, adr.Top, adr2.Width,          adr2.Height)
      s.Name = NomImage & "_" & adr.Address
   End If
End Function

JB

 

[ALE60620]

Re : inserer une image selon la valeur du champ

Re,

Vois si ça te va... Si j'ai bien compris.

Ici.

Bonne nuit.

Hulk.

Bonjour, merci beaucoup de mettre votre talent à la disposition des novices, cette macro m'interesse mais je n'arrive pas à faire apparaitre l'image dans la colonne I au lieu de la B. Pouvez-vous m'aider ? Par avance, merci beaucoup. Ale