Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Insérer image avec condition valeur ds cellule

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Cremouenette

XLDnaute Nouveau
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 :

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
 
Re : Insérer image avec condition valeur ds cellule

Je suis pas loin du binheur!!!!

J'ai trouvé cela :

Code:
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
 
Re : Insérer image avec condition valeur ds cellule

Bon il y a du mieux :

Code:
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
 
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

Code:
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 choisir une page
Réponses
6
Affichages
806
Réponses
0
Affichages
2 K
Réponses
58
Affichages
6 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…