Insérer image avec condition valeur ds cellule

[Cremouenette]

Bonjour a tous!

Voila mon soucis : J'aimerais insérer une image selon la valeur donné dans une cellule.

Sur ce forum j'ai trouvé ce code :

With Application.FileSearch
.NewSearch
.FileName = ".bmp"
.LookIn = ThisWorkbook.Path
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending

            If .Execute > 0 Then
                  Set MyCell = Target.Offset(0, 1)
                  MyCell.Select
                  Set MyPicture = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Val & ".bmp")
                  With MyPicture.ShapeRange
                  .LockAspectRatio = msoFalse
                  .Height = MyCell.Height
                  .Width = MyCell.Width
                  End With
                  MyCell.Select
            End If
            
  End With
  Application.ScreenUpdating = True
  Exit Sub
  
errorhandler:
 Application.ScreenUpdating = True
 Exit Sub

End Sub

Qui est un début de solution pour moi MAIS (oui il y a un mais, sinon c est pas drôle , je ne peux pas avoir les fichiers images dans un répertoire mais directement ds le classeur excel!

J'avais pensé à définir un nom pour l'image et faire un =image, mais cela ne marche pas!

Merci de m'éclairer, je suis sur que c'est possible


sinon : comment creer une police de caratere en couleur avec des gif ou jpg?

merci

 

[Cremouenette]

Re : Insérer image avec condition valeur ds cellule

Je suis pas loin du binheur!!!!

J'ai trouvé cela :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Worksheets("Feuil1").Range("B2").Value > 10 Then
Image1.Visible = True
Image2.Visible = False
Else
Image1.Visible = False
Image2.Visible = True
End If
End Sub

Qui est pile poil ce que je cherche!

J'ai donc 2 images, nommées respectivement Image1 et Image2, sauf que la macro s'arrete sur "Image1.Visible = True" "erreur d exécution 424" objet requis!!!


A vot'e bon coeur msieurs, dames!! :d

 

[Cremouenette]

Re : Insérer image avec condition valeur ds cellule

bon si je comprend bien faut que je les déclare en tant qu'obet

comment?

dim heuuu...... je sais plus lol

 

[Cremouenette]

Re : Insérer image avec condition valeur ds cellule

Bon il y a du mieux :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Image1 As IPictureDisp ' Objet image
Dim Image2 As IPictureDisp ' Objet image
If Worksheets("Feuil1").Range("B2").Value > 10 Then
Image1.Visible = True
Image2.Visible = False
Else
Image1.Visible = False
Image2.Visible = True
End If
End Sub

Mais maintenant il s'arrete sur : Image1.Visible = False me disant : Erreur 91 variable objet ou variable de bloc With non définie

 

[BOISGONTIER]

Re : Insérer image avec condition valeur ds cellule

Bonjour,

Les images et shapes

JB

 

[wilfried_42]

Re : Insérer image avec condition valeur ds cellule

Bonjour à tous

voici une fonction personnalisée à placer dans un module standard
cette fonction permet d'afficher une image dans une cellule voire une plage fusionnée selon le meme principe qu'une formule

Public 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 = "#VALEUR"
            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

En A1 le nom de l'image
en B1 la formule : =Image(A1 & ".Gif" ;"Mon chemin")
le 2eme paramètre est optionnel, il est inutile si le chemin de l'image est identique à celui du classeur