Modifier la fonction Affiche image

[gabriel.jean1]

Bonjour,

Je suis débutant en Excel et Vb et j'ai trouvé une macro de "Boisgontier" :

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

puis j'ai des cellules (plus de 200) avec des chemins (converti en dos pour compatibilité)

F:\stockage\PHOTOC~2\IMG_3291.JPG

puis une autre page avec :

=afficheimage(Sheet1!BN2,"")

Qui marche sous Excel 2010 si je relance mon fichier les images sont bien affiché,
mais pas à la bonne taille elle remplisse une seule cellule celle qui contient la fonction d'affichage alors que j'ai fusionné plusieurs cellules et mis la formule.

Sur les anciennes versions d'Excel ce problème ne se posait pas avez vous une solution pour modifier la macro et adapter la taille de l'image à un ensemble de cellules fusionner.

J'ai tester la macro VB Formation Excel VBA JB "AfficheImageCentrée" dont le code est plus important, mais ça ne marche pas aucune image afficher avec l'exemple et un test resultat = #VALEUR!

Je pense me souvenir que la fonction dont je parle en premier est plus récente que celle-ci, mais je n’en suis pas sur.

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
  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))
       Ech = adr.Height / H
       lgcel = adr.Width
       H = H * Ech
       L = L * Ech
       Set s = f.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

il affiche l'image en tout petit avec résultat zéro (0) si j'efface l'image et que je valide dans la ligne fonction en pressant "enter" ça marche ?

(bravo à toute l'équipe du forum pour le travail pour l'aide sur Excel et les macros offerte).

Merci.

 

[gabriel.jean1]

Re : Modifier la fonction Affiche image

Bonjour,

up

Merci.