XL 2013 Afficher une image en cliquant sur une miniature

[Jouxte]

Bonjour à toutes et tous,

J'ai retrouvé un fichier (affichephoto2.xls) du regretté Jacques Boisgontier, mais qui me génère une erreur sur la ligne :
rap = Val(Split(taille, "x")(0)) / Val(Split(taille, "x")(1))

je joins le fichier en PJ
quelqu'un peut-il m'aider à faire fonctionner ce code.
Par avance merci pour votre aide

 

[bof]

Bonjour,
Chez moi j'ai un résultat correct avec le code suivant :

Sub Affichephoto()
 répertoire = ThisWorkbook.Path
 NomImage = Application.Caller
 If Dir(répertoire & "\" & NomImage & ".jpg") <> "" Then
   taille = TaillePixelsImage(répertoire, NomImage & ".jpg")
   larg = Split(taille)(0)
   haut = Split(taille)(2)
   rap = Val(Mid(haut, 2)) / Val(Mid(larg, 2))
   UserForm1.Image1.Height = 200
   UserForm1.Image1.Width = UserForm1.Image1.Height * rap
   UserForm1.Height = UserForm1.Image1.Height + 20
   UserForm1.Width = UserForm1.Image1.Width
   UserForm1.Image1.Picture = LoadPicture(répertoire & "\" & NomImage & ".jpg")
   UserForm1.Show
 End If
End Sub
Function TaillePixelsImage(repertoire, fichier)
  Set myShell = CreateObject("Shell.Application")
  Set myFolder = myShell.Namespace(repertoire)
  Set myFile = myFolder.Items.Item(fichier)
  TaillePixelsImage = myFolder.GetDetailsOf(myFile, 176) & " " & myFolder.GetDetailsOf(myFile, 178)
End Function

A+

 

[riton00]

Bonjour,

Fichier toujours fonctionnel sur excel 2003, ne fonctionne plus à partir de 2007
voir ICI

Slts

 

[bof]

Bonjour,
Ma version (ci dessus) est fonctionnelle sur 2016.
Attention il est probable (non vérifié) que le nom de l'image interne doit être identique à l'image cible... Et que ce soit sensible à la casse ! Sur votre classeur joint les noms des images sont écrits sans majuscule donc il est probable que ça peut ne pas marcher sauf à modifier en conséquence...
A+

 

[Jouxte]

Merci bof & riton00 pour vos réponse rapides et qui sont parfaitement fonctionnelles.

 

[Jouxte]

Est-il possible d'autoriser plusieurs formats d'image ".jpg", ".png", ".gif", ".bmp" ?

 

[bof]

C'est possible pour les gif en reliant la miniature à cette macro :

Sub AfficheGif()
 répertoire = ThisWorkbook.Path
 NomImage = Application.Caller
 If Dir(répertoire & "\" & NomImage & ".gif") <> "" Then
   taille = TaillePixelsImage(répertoire, NomImage & ".gif")
   larg = Split(taille)(0)
   haut = Split(taille)(2)
   rap = Val(Mid(haut, 2)) / Val(Mid(larg, 2))
   UserForm1.Image1.Height = 200
   UserForm1.Image1.Width = UserForm1.Image1.Height * rap
   UserForm1.Height = UserForm1.Image1.Height + 20
   UserForm1.Width = UserForm1.Image1.Width
   UserForm1.Image1.Picture = LoadPicture(répertoire & "\" & NomImage & ".gif")
   UserForm1.Show
 End If
End Sub

Pour les autres format je n'ai pas essayé car je n'ai pas d'image disponible tous les formats demandés, mais tu peux tenter une macro similaire en changeant juste l'extension. Bien sur il faudra faire attention au moment de l'affectation des boutons à la macro de ne pas se mélanger les crayons...
A+

 

[Jouxte]

Bonjour le Forum,
J'ai modifié le code comme suit, les images ".jpg", ".gif", ".bmp" s'affichent correctement mais pas les ".png"
Il y a une demande de deboguage sur la ligne (erreur d'exécution 481 Image incorrecte) :
UserForm1.Image1.Picture = LoadPicture(répertoire & "\" & NomImage & c)

Sub Affichephoto()
 Dim c
 répertoire = ThisWorkbook.Path
 NomImage = Application.Caller
 For Each c In Array(".jpg", ".png", ".gif", ".bmp")
 
 If Dir(répertoire & "\" & NomImage & c) <> "" Then
   taille = TaillePixelsImage(répertoire, NomImage & c)
   larg = Split(taille)(2)
   haut = Split(taille)(2)
   rap = Val(Mid(haut, 2)) / Val(Mid(larg, 2))
   UserForm1.Image1.Height = 700
   UserForm1.Image1.Width = UserForm1.Image1.Height * rap
   UserForm1.Height = UserForm1.Image1.Height + 20
   UserForm1.Width = UserForm1.Image1.Width
   UserForm1.Image1.Picture = LoadPicture(répertoire & "\" & NomImage & c)
      UserForm1.Show
    End If
 Next
 
End Sub
Function TaillePixelsImage(repertoire, fichier)
  Set myShell = CreateObject("Shell.Application")
  Set myFolder = myShell.Namespace(repertoire)
  Set myFile = myFolder.Items.Item(fichier)
  TaillePixelsImage = myFolder.GetDetailsOf(myFile, 176) & " " & myFolder.GetDetailsOf(myFile, 178)
End Function

Merci par avance pour votre aide

 

[bof]

LoadPicture n'accepte qu'un nombre limité de format ; Il est très possible que png ne soit pas reconnu.
A+

 

[Jouxte]

@ bof
Effectivement une recherche sur internet confirme tes dires.
J'ai trouvé sur un forum un fichier qui affiche les .png
Je suis incapable de m'aider de ce fichier mais si ça peut aider l'un d'entre-vous à résoudre mon problème ...
Par avance merci pour vos solutions.