Afficher une image en fonction d'un calcul

Résolu
Fabulous_fab Messages postés 6 Statut Membre -  
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,
J'essaye en vain d'afficher une image dans une cellule Excel en fonction du résultat d'une opération et je n'y arrive pas. J'ai vu des tas de solutions se rapprochant de mon problème mais je n'arrive pas à les mettre en oeuvre.
C'est pourtant quelque chose de simple, j'en conviens, mais je ne maitrise pas du tout vba.
Ce que je cherche à faire :
Si D3 <= 50%, afficher l'image 'pluie'
Si D3 <= 75%, afficher l'image 'nuage'
Si D3 > 75%, afficher l'image 'soleil'
Et le tout sans avoir à appuyer sur un boutoon d'action.
Merci de votre aide précieuse.
A voir également:

7 réponses

Réponse 1 / 7
chtilou Messages postés 1704 Statut Membre 523
 
Un problème similaire au tien à déjà été résolu ici.
0
Fabulous_fab Messages postés 6 Statut Membre 1
 
Je l'avais bien vu mais je n'arrive pas à m'en servir.
D'où vient mon problème ? A part de moi, car ca c'est fait !

J'ai fait copier-coller du texte (depuis Private Sub ... jusqu'à End Sub) dans une feuille vba en modifiant Feuil2 par Feuil1 puisque je suis en Feuil1, puis en donnant le bon chemin d'accès aux images, mais cela ne fait rien. Dois-je déclarer quelque part que cela doit être appliqué ? Ou autre ?
Merci de ton aide.
0
Réponse 2 / 7
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 281
 
Bonjour,

as-tu testé en mettant une valeur dans D3 (<1) ?
Car l'evenement change ne réagit pas sur une formule
eric
0
Fabulous_fab
 
Oui, mais cela ne fait rien. Le code que j'utilise est le suivant :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

' déclaration des variables
Dim objFeuille As Worksheet, objPict As Picture
Dim fichier As String
Dim positionX As String
Dim positionY As String

' définition des objets
Set objFeuille = ActiveSheet

' définition de la position et de l'image en fonction de la valeur
If Worksheets("Feuil1").Range("D3").Value < 0.5 Then fichier = "C:\Users\xxx\Image1.png"
positionX = "L10"
positionY = "L10"
ElseIf Worksheets("Feuil1").Range("D3").Value >= 0.5 And Worksheets("Feuil1").Range("D3").Value < 0.7 Then fichier = "C:\Users\xxx\Image2.jpg"
positionX = "L10"
positionY = "L10"
ElseIf Worksheets("Feuil1").Range("D3").Value >= 0.7 And Worksheets("Feuil1").Range("D3").Value < 0.9 Then fichier = "C:\Users\xxx\Image3.png"
positionX = "L10"
positionY = "L10"
ElseIf Worksheets("Feuil1").Range("D3").Value >= 0.9 Then fichier = "C:\Users\xxx\Image4.png"
positionX = "L10"
positionY = "L10"
End If

' positionnement de l'objet
Set objPict = objFeuille.Pictures.Insert(fichier)
With objPict
.Left = Range(positionX).Left
.Top = Range(positionY).Top
End With

End Sub

En me positionnant en cellule D3 sur la feuille 1 et en mettant des valeurs <1 cela ne donne rien. Normalement en L10 je devrais avoir une image qui change, mais rien !!!
0
Réponse 3 / 7
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 281
 
Bonsoir,

Pourquoi dis-tu que ça ne fait rien alors que ça te donne un message d'erreur ?
Tu ne crois pas que ça serait plus simple de décrire précisément ?
Voilà le code corrigé : 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

' déclaration des variables
    Dim objFeuille As Worksheet, objPict As Picture
    Dim fichier As String
    Dim positionX As String
    Dim positionY As String

    ' définition des objets
    Set objFeuille = ActiveSheet

    ' définition de la position et de l'image en fonction de la valeur
    If Worksheets("Feuil1").Range("D3").Value < 0.5 Then
    fichier = "C:\tmp\image.bmp"
    positionX = "L10"
    positionY = "L10"
ElseIf Worksheets("Feuil1").Range("D3").Value >= 0.5 And Worksheets("Feuil1").Range("D3").Value < 0.7 Then
    fichier = "C:\tmp\Image2.jpg"
    positionX = "L10"
    positionY = "L10"
ElseIf Worksheets("Feuil1").Range("D3").Value >= 0.7 And Worksheets("Feuil1").Range("D3").Value < 0.9 Then
    fichier = "C:\tmp\Image3.png"
    positionX = "L10"
    positionY = "L10"
ElseIf Worksheets("Feuil1").Range("D3").Value >= 0.9 Then
    fichier = "C:\Users\xxx\Image4.png"
    positionX = "L10"
    positionY = "L10"
End If

' positionnement de l'objet
Set objPict = objFeuille.Pictures.Insert(fichier)
With objPict
    .Left = Range(positionX).Left
    .Top = Range(positionY).Top
End With
End Sub

J'ai juste testé avec <0.5 et c'est bon, tu peux mettre en résolu et éventuellement poser une autre question si tu as un nouveau pb.
eric
0
Fabulous-fab
 
C'est dingue mais cela ne fait rien du tout sur mon pc !
En fait c'est peut-être dans la façon dont je le fait.
Je prend un fichier excel et pour ouvrir vba je fais alt+f11 et je fais copier-coller du code. Ensuite je ferme la fenêtre et modifie les valeurs de ma cellule D3. Et rien n'apparait, ni message d'erreur, ni image, ni rien du tout.
Je n'y connais rien en dév, mais là avec toutes ces explications, j'ai en plus l'impression d'être un sacré neu-neu.
Je ne vois pas du tout où je peux me tromper. J'ai essayer de créer une macro (nouvelle macro et copier-coller du code), mais cela ne change rien (en l'ajoutant il me met un message d'erreur = Nom ambigu detecté : Worksheet_Change) ???
0
Réponse 4 / 7
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 281
 
Voilà un fichier avec la macro si ça peut te permettre de voir où tu faisais une erreur.
http://www.cijoint.fr/cjlink.php?file=cj200805/cijjF4HsqA.xls
J'ai mis un point d'arret au début, tu peux faire en pas à pas avec F8 et contrôler sur le classeur le résultat au fur et à mesure, ou relancer jusqu'au bout par F5

eric
0
Fabulous_fab
 
J'aibien récuperé ton fichier et cela fonctionne, en effet.
Par contre quand je copie le code dans mon fichier cela ne fait plus rien !!!
Dans ton fichier, quan je regarde à droite je vois plein de valeurs (propriété feuill1) que je n'ai pas. Ai-je oublié de valider quelque chose ?
Ceci dit je n'ai toujours pas réussi à exécuter le code pas à pas avcec F8 !
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 281
 
Dans le menu affichage tu peux choisir des fenetres dont celle des propriétés.
Mais ce n'est pas ça qui empeche ton programme de tourner.
Il faut mettre ton fichier sur cijoint.fr et coller le lien ici si tu veux que qcq'un se penche dessus...
0
Fabulous_fab Messages postés 6 Statut Membre 1
 
C'est fait : http://www.cijoint.fr/cjlink.php?file=cj200805/cijL2WLAPd.xls
En ce qui concerne les propriétés j'ai bien la boite de dialogue mais elle est souvent vide en fait.
Je n'arrive toujours pas à utiliser la fonction pas-à-pas pour dérouler le code. Ce qui me permettrait peut-être de voir d'où ça vient.
Par ailleurs je souhaiterai effacer l'image avant d'insérer une nouvelle, sinon à chaque nouvelle valeur il me colle une nouvelle image, même si c'est la même.
Merci de votre aide
0
Réponse 6 / 7
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 281
 
Bonjour,

tu n'es pas très observateur...
Ton code est dans un module, Worksheet_Change est un evenement feuille, je te l'avais mis dans Feuil1.
Pour effacer l'image ajoute avant le 1er if : 
    On Error Resume Next
    ActiveSheet.Pictures("meteo").Delete

eric
0
Fabulous_fab Messages postés 6 Statut Membre 1
 
Re,
Ta formule pour effacer ne fontionne pas sur mon pc, avec ton fichier.
Par ailleurs dès que je modifie n'imorte quelle cellule il affiche à nouveau l'image en fonction de la valeur de la cellule D3.
As-tu pu voir d'oû venait le souci avec mon fichier ?
Merci d'avance
0
Réponse 7 / 7
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 281
 
Bonsoir,

L'effacement ne marche pas effectivement car j'ai oublié de te dire de renommer ton image après son insertion.
Le fait que la ma macro réagit sur toutes les cellules c'est parce que c'est ainsi que tu l'as fournie.
Ca aurait dû faire l'objet d'une nouvelle discussion si tu veux que tout le monde lise ta question.
J'y répond pour cette fois mais j'aimerais bien que tu passes le sujet en résolu la question de départ 'J'essaye en vain d'afficher une image... ' étant réglée.
Merci 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

' déclaration des variables
    Dim objFeuille As Worksheet, objPict As Picture
    Dim fichier As String
    Dim positionX As String
    Dim positionY As String
    If Intersect(Target, Range("D3")) Is Nothing Then Exit Sub
    ' définition des objets
    Set objFeuille = ActiveSheet

    ' définition de la position et de l'image en fonction de la valeur

    On Error Resume Next
    ActiveSheet.Pictures("meteo").Delete

    If Worksheets("Feuil1").Range("D3").Value < 0.5 Then
        fichier = "C:\tmp\Leon_Fr.bmp"
        positionX = "L10"
        positionY = "L10"
    ElseIf Worksheets("Feuil1").Range("D3").Value >= 0.5 And Worksheets("Feuil1").Range("D3").Value < 0.7 Then
        fichier = "C:\xxx\Image2.gif"
        positionX = "L10"
        positionY = "L10"
    ElseIf Worksheets("Feuil1").Range("D3").Value >= 0.7 And Worksheets("Feuil1").Range("D3").Value < 0.9 Then
        fichier = "C:\xxx\Image3.gif"
        positionX = "L10"
        positionY = "L10"
    ElseIf Worksheets("Feuil1").Range("D3").Value >= 0.9 Then
        fichier = "C:\xxx\Image4.gif"
        positionX = "L10"
        positionY = "L10"
    End If

    ' positionnement de l'objet
    Set objPict = objFeuille.Pictures.Insert(fichier)
    With objPict
        .Left = Range(positionX).Left
        .Top = Range(positionY).Top
        .Name = "meteo"
    End With
End Sub


eric
0

Discussions similaires

PIX
plart -
jordane45 -

1 réponse
Retrouver l'image originale après avoir fait des modifications ?
Raven -
Asta972155 -

10 réponses
additionner nombres dans cellules avec texte
kawimaki -
kawimaki -

6 réponses
Remplir une cellule (texte) en fonction d'une autre (texte).
SOMUM -
SOMUM -

4 réponses
Dechiffrer une image caché
JACQUE -
Otomec -

1 réponse