Trombinoscpe presque fini

Bonjour à tous,

Vous trouverez en pièces-jointes 3 photos compressées (photos.rar) et un fichier excel. Le fichier excel est un trombinoscope que j'ai l'année dernière réussi à faire fonctionner mais qui depuis quelques temps me donne du fil à retordre. Je viens donc chercher sur le forum un expert à l'âme charitable

L'affichage automatique des images est géré par la macro "afficheimage(nom_de_l_image.png;adresse du répertoire des photos)".

Dans l'onglet "LISTING" on renseigne les prénoms et noms dans le cadre jaune des colonnes B et C.

Ensuite, dans la colonne A de l'onglet "LISTING" on retrouvera l'identifiant de l'image: Prénom_NOM

La macro afficheimage fera référence aux éléments de la colonne A de l'onglet "LISTING". L'utilisateur prendra soin d'ajouter ".png".

Dans l'onglet "TROMBI" on retrouve le couple Prénom/NOM normalement accompagné de l'image qui va bien.

Mon problème c'est justement que les images ne s'affichent pas malgré un nom d'image et une adresse de répertoire correctes.

Pourriez-vous m'aider ?

Merci d'avance.

PS.

=afficheimage(LISTING!A3&".png";"C:\zzz_Correction\photos\")

afficheimage: nom de la macro

LISTING!A3: identifiant de l'image Prénom_NOM

.png: pour faire appel aux images .png ranger dans le répertoire dont l'adresse est le second paramètre de la macro

Microsoft Office Excel 2007 SP3 MSO

Windows 8.1 64Bits

Bonjour,

Chouette fonction !!!

Avec

=afficheimage(LISTING!A3&".png";"C:\zzz_Correction\photos")

J'obtiens "Inconnu" ce qui correspond à ta macro si le nom est vide... on progresse

Leakim

Bonjour

J'ai modifié la macro

Chez moi les images s'affichent

Function AfficheImage(NomImage, rep)
  Application.Volatile
  'rep = ThisWorkbook.Path & "\Photos\"
  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)
       taille = myFolder.GetDetailsOf(myFile, 31)
      taille = Replace(taille, ChrW(8234), "")       ' Enlève le ? en début
       taille = Replace(taille, ChrW(8236), "")       ' Enlève le ? en fin
       H = Val(Split(taille, "x")(1))
       L = Val(Split(taille, "x")(0))
       Ech = adr.Height / H
       H = H * Ech
       L = L * Ech
       Set s = adr.Worksheet.Shapes.AddPicture(rep & NomImage, True, True, adr.Left + 1, adr.Top + 1, L - 2, H - 2)
       s.Name = NomImage & "_" & adr.Address
       AfficheImage = "ok"
    End If
  End If
End Function

Merci à leakim et Banzai64 pour leur aide.

Réponse rapide et précise. Merci encore à toi Banzai64 : chapeau!

Bonjour,

Salutation du matin Banzai !

Merci pour cette macro...

Si je veux que mes images soient centrées par rapport à la cellule du dessous ? Je modifie quoi ?

Cordialement,

Leakim

Bonjour

A tester

Set s = adr.Worksheet.Shapes.AddPicture(rep & NomImage, True, True, adr.Left + (adr.Width / 2) - (L / 2), adr.Top + 1, L - 2, H - 2)

Bonjour,

Merci banzai, j'ai finalement mis

Set s = adr.Worksheet.Shapes.AddPicture(rep & NomImage, True, True, adr.Left + (adr.Width / 2) - (L / 2), adr.Top + 1, L - 1, H - 2)

Et ajouter trois espaces

AfficheImage = "    ok"

Pour que ok ne soit plus visible

Merci aussi à Julien_1_2_3_4_5 pour ce post

Leakim