Import automatique d'une image selon un chemin contenu dans la feuille

[Escargot04]

Bonjour,

Je cherche un moyen simple, vraiment très simple, d'afficher une image automatiquement en fonction d'un chemin.

Comme un dessin est souvent plus clair que de longues explication :

Cette image doit pouvoir se charger automatiquement lors de la mise à jour des valeurs.

D'avance merci 😱

 

[BOISGONTIER]

Re : Import automatique d'une image selon un chemin contenu dans la feuille

Bonjour,

http://boisgontierjacques.free.fr/fichiers/Images/FonctionImageChemin.xls

JB

 

[Escargot04]

Re : Import automatique d'une image selon un chemin contenu dans la feuille

Merci 🙂
Je viens de faire un petit essais
Visiblement, cela fonctionne très bien si le chemin est en dur, mais pas avec le =Résultat du RechercheV
Comment faire pour que l'image garde ces proportions ?

Je suis désolé, je ne suis pas du tout doué avec Excel 😱

 

[Escargot04]

Re : Import automatique d'une image selon un chemin contenu dans la feuille

Je tente d'utiliser la macro qui est dans le fichier FonctionAfficheImage5.xls trouvé sur votre site (qui est d'ailleurs formidable !!) mais je n'y arrive pas !

J'ai mis cette formule dans la cellule groupée :
=afficheImage(U11&".jpg";"V:\Images Fiche Technique\Dessins\")

Je met en pièce jointe la copie d'écran de mon fichier afin que vous y trouvier les informations

La macro :

Function AfficheImage(NomImage, Optional rep)
  Application.Volatile
  If IsMissing(rep) Then rep = ThisWorkbook.Path & "\"
  Set f = Sheets(Application.Caller.Parent.Name)
  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
     If Dir(rep & NomImage) = "" Then
        AfficheImage = "Inconnu"
     Else
       Set myShell = CreateObject("Shell.Application")
       If TypeName(rep) = "Range" Then
          Set myFolder = myShell.Namespace(rep.Value)
       Else
          Set myFolder = myShell.Namespace(rep)
       End If
       Set myFile = myFolder.Items.Item(NomImage)
       Taille = myFolder.GetDetailsOf(myFile, 26)
       H = Val(Split(Taille, "x")(1))
       L = Val(Split(Taille, "x")(0))
       echH = adr2.Height / H
       EchL = adr2.Width / L
       If L * echH > adr2.Width Then ech = EchL Else ech = echH
       H = H * ech
       L = L * ech
       f.Shapes.AddPicture(rep & NomImage, True, True, adr.Left, adr.Top, L, H).Name = NomImage & "_" & adr.Address
       AfficheImage = ""
    End If
  End If
End Function