Adapter Fonction Affiche image

[Jiheme]

Bonjour à tous

Pas moyen, malgré grosses migraines, d'adapter la fonction affiche image à mon cas, le podieum du championnat de L1, dans le zip ci joint le fichier et les images.

Pour info, le fichier et les images sont dans le même répertoire.

Merci
A+

 

[BOISGONTIER]

Re : Adapter Fonction Affiche image

Bonjour,

En E5: =AfficheImage(E6&"";"c:\mesdoc\jiheme\")

ou

=AfficheImage(RECHERCHEV(deux;data;2;0);"c:\mesdoc\jiheme\")

En G3:
=AfficheImage(RECHERCHEV(prem;data;2;0)&"";"c:\mesdoc\jiheme\")


JB

 

[Jiheme]

Re : Adapter Fonction Affiche image

Bonjour Boisgontier, re à tous

Merci beaucoup, encore mieux sans la cellule de transition.

Au risque d'abuser, pourquoi les "" après E6& ?😕

Encore merci

A+

 

[Compte Supprimé 979]

Re : Adapter Fonction Affiche image

Bonjour à vous 😉

Tu peux également modifié quelque peu la fonction à Mister Boisgontier
Si le fichier Excel se trouve dans le même répertoire que celui du dossier "Foot" qui contient les images

Function AfficheImage(NomImage As String, Rep As String)
  Dim VPath As String
  Application.Volatile
  ' Définir le chemin du répertoire
  VPath = ThisWorkbook.Path & "\" & Rep & "\"
  Rep = VPath
  '
  Set adr = Application.Caller
  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")
       Set MyFolder = MyShell.Namespace(Rep)
       Set MyFile = MyFolder.Items.Item(NomImage)
       Taille = MyFolder.GetDetailsOf(MyFile, 26)
       H = Val(Split(Taille, "x")(1))
       L = Val(Split(Taille, "x")(0))
       Ech = adr.Height / H
       lgcel = adr.Width
       H = H * Ech
       L = L * Ech
       Set s = adr.Worksheet.Shapes.AddPicture(Rep & NomImage, True, True, adr.Left + adr.Width / 2 - L / 2 + 1, adr.Top + 1, L - 2, H - 2)
       s.Name = NomImage & "_" & adr.Address
       AfficheImage = "ok"
    End If
  End If
End Function

Edit : Oups un peu tard
De plus n'a pas l'air de fonctionner tout le temps !?

A+

 

[Jiheme]

Re : Adapter Fonction Affiche image

Bonjour Bruno


Merci, je garde ta proposition sous le coude pour voir ce que tu as modifié, cela m'aidera sûrement à comprendre.

A+