Jeremouse1
XLDnaute Nouveau
Bonjour,
dans un fichier Excel qui contient plusieurs feuilles j'ai insérer une fonction Image que j'ai trouvé sur Internet et qui affiche une image en fonction de la valeur d'une cellule. Cependant je voudrais que cette fonction ne s'exécute que sur la première feuille et pas sur les autres, pouvez vous m'aider ?
Voici la fonction
Merci d'avance
Jeremouse1
dans un fichier Excel qui contient plusieurs feuilles j'ai insérer une fonction Image que j'ai trouvé sur Internet et qui affiche une image en fonction de la valeur d'une cellule. Cependant je voudrais que cette fonction ne s'exécute que sur la première feuille et pas sur les autres, pouvez vous m'aider ?
Voici la fonction
Code:
Function Image(img_nom As Variant, Optional chemin As String = "") As String
' Declaration des variables
Dim ref As Range, sh As Shape, drap As Boolean
' ref : la cellule qui provoque la fonction
' sh : les shapes
' Drap : drapeau definissant si la shape est trouvée
Application.Volatile ' defini une fonction qui se recalcule automatiquement
' teste le type de variable soit une cellule soit une valeur alphanumerique
Select Case TypeName(img_nom)
Case "Range" ' c'est une reference cellule
Image = img_nom.Value
Case "String" ' c'est une valeur alphanumerique
Image = img_nom
Case Else ' c'est une erreur
Image = "#ERROR"
Exit Function
End Select
' le chemin est un parametre optionnel, s'il est omis, la valeur est le chemin du classeur
If chemin = "" Then chemin = ThisWorkbook.Path
' le chemin ne se termine pas forcemment par \ je le rajoute
If Right(chemin, 1) <> "\" Then chemin = chemin & "\"
Set ref = Application.Caller ' affectaction à ref de la cellule qui lance la fonction
If ref.MergeCells = True Then Set ref = Range(ref.MergeArea.Address)
drap = False ' initialisation du drapeau
For Each sh In ref.Worksheet.Shapes ' je passe en revue toute les shapes
' je teste son nom construite plus bas pour savoir si c'est la bonne shappe
If "Img-" & ref.Address = Left(sh.Name, Len(ref.Address) + 4) Then drap = True: Exit For
Next
If drap = True Then ' c'est la bonne shape
' je teste maintenant si c'est la meme que celle de la formule pour ne pas refaire le traitement
' Le gain de temps n'est pas negligeable
If "Img-" & ref.Address & "-" & Image = sh.Name Then GoTo fin ' egalité parfaite, je sors
End If
On Error Resume Next ' controle d'erreur, si la shape n'existe pas encore, l'instruction suivante provoque une erreur
sh.Delete ' je detruits la shap
If Image = "" Then Exit Function ' la valeur est à "" alors pas de shape à affecter
' j'inserre la shape, avec l'image en lui mettant les tailles necessaires pour la cellule
Set sh = ref.Worksheet.Shapes.AddPicture(chemin & Image, True, True, ref.Left, ref.Top, ref.Width, ref.Height)
sh.Name = "Img-" & ref.Address & "-" & Image ' je definis son nom pour la trouver plus tard
fin:
Image = "Img" & ref.Address ' j'affecte un nom pour resultat
End Function
Merci d'avance
Jeremouse1