Insertion image dans cellule

Version imprimable

27/08/2011, 08h51
MENOT72

Insertion image dans cellule

Bonjour,

Je cherche à insérer une image dans une cellule en fonction du résultat obtenu dans la cellule voisine.
Sur le forum j'ai trouvé la réponse de " mercatog" de juin 2011 qui me convient parfaitement; mais je n'arrive pas à adapter ses conditions d'affichage.

Je voudrais seulement trois conditions en fonction du résultat obtenu dans ma cellule: -5%, entre -5% et +5% et supérieur à 5%.
Mon souci est que je n'arrive pas à adapter la première partie de son code.

Je vous remercie pour l'aide que vous pourriez m'apporter.
27/08/2011, 10h55
Didier Gonard

Bonjour,

En mettant le lien vers le sujet évoqué, en mettant la partie de code concernée et en explicitant le problème ça sera plus facile de répondre ;)

cordialement,

Didier

1 pièce(s) jointe(s)

Merci pour ta réponse et excuses moi pour l'oubli je suis impardonable.

Je te joins le fichier initial de "mercatog" sur le quel j'ai travaillé. Son problème était d'afficher une image en fonction de la moyenne du résultat des 5 jours précédents.

Mon problème est beaucoup plus simple, je veux afficher une image par exemple en G11, pour un résultat de calcul qui s'affiche en F11 sous la forme d'un pourcentage. J'aimerais que mon image change si ce résultat est inférieur à -5%, supérieur à +5% ou entre -5% et +5%.

J'ai donc essayé de modifier le code de mercatog ( le IF ) qui est joint au fichier, mais je n'y arrive pas.

Excuses moi mais je suis un débutant et j'essaie tous les jours de m'améliorer.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 Sub Worksheet_Change(ByVal Target As Range) Dim Fichier As String, Chemin As String Dim R As Long, S As Long Dim M As Double If Target.Count = 1 And Target.Column = 2 And Target.Row > 1 Then R = Target.Row If R <= 6 Then S = 2 Else S = R - 4 End If 'Moyenne des 5 derniers jours, si <5 jours, moyenne des jours à partir de B2 M = Evaluate("AVERAGE(B" & S & ":B" & R & ")") Chemin = "C:\Documents and Settings\MENOT\Bureau\Emoti\" Select Case M Case Is <= 450: Fichier = "smiley_bon.gif" Case Is <= 500: Fichier = "smiley_egal.gif" Case Else: Fichier = "smiley_mauvais.gif" End Select Worksheets("météo").Image1.Picture = LoadPicture(Chemin & Fichier) End If End Sub
.

Merci de ton aide.

27/08/2011, 17h00
SfJ5Rpw8

Est le code modifié ?

Target c'est une référence vers la cellule qui change d'état .. modifie donc la ligne IF qui définit les cellules concernées par ton code :

Code:

If Target.Count = 1 And Target.Column = 2 And Target.Row > 1 Then

par exemple en restant sur les colonnes/lignes : pour F11

Code:

If Target.Count = 1 And Target.Column = 6And Target.Row =11 Then

ensuite si l'image à afficher dépends seulement de la valeur calculée en F11.. modifie l'intérieur de ton IF en simplifiant et laissant juste un case...
puis montre nous ou tu en est et dit nous ce qui se passe ...

Insertion image

Merci pour ta réponse

Voilà où j'en suis : j'insère bien mon image en G11, mais elle ne change pas avec le changement de valeur de F11

Mon code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim Fichier As String, Chemin As String
 
 
Dim M As Double
 
 
If Target.Count = 1 And Target.Column = 6 And Target.Row = 11 Then
 
 
 
 
    M = Cells("G", "11")
 
    Chemin = "C:\Users\REGIS\Desktop\Emoti\"
 
    Select Case M
 
        Case Is <= -5: Fichier = "smiley_mauvais.gif"
 
        Case Is > 5: Fichier = "smiley_bon.gif"
 
        Case Else: Fichier = "smiley_egal.gif"
 
    End Select
 
    Worksheets("données").Image1.Picture = LoadPicture(Chemin & Fichier)
 
End If
 
End Sub

Encore merci pour ta patience

27/08/2011, 18h37
SfJ5Rpw8

Target te renvoi la cellule modifié ... tu n'as pas besoin de ton M...

Code:

Select Case Target

Je l'ai modifié ainsi mais j'ai toujours le même problème; il ne choisit que l'image " egal"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim Fichier As String, Chemin As String
 
If Target.Count = 1 And Target.Column = 6 And Target.Row = 11 Then
 
    Chemin = "C:\Users\REGIS\Desktop\Emoti\"
 
    Select Case Target.Column = 7 And Target.Row = 11
 
        Case Is <= -5: Fichier = "smiley_mauvais.gif"
 
        Case Is > 5: Fichier = "smiley_bon.gif"
 
        Case Else: Fichier = "smiley_egal.gif"
 
    End Select
 
    Worksheets("données").Image1.Picture = LoadPicture(Chemin & Fichier)
 
End If
 
End Sub

27/08/2011, 18h59
SfJ5Rpw8

Pour tester la valeur dans la cellule tu mais juste le code que j'ai posté :

Code:

Select Case Target

pas de AND et .Column....

insertion image

Je suis trop nul et j'aime ça......
J'ai enfin compris et tout marche nickel.
Je te remercie vivement pour ta patience et ta gentillesse.
Je joins le code définitif qui peut servir à un autre

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim Fichier As String, Chemin As String
 
 
 
 
 
If Target.Count = 1 And Target.Column = 6 And Target.Row = 11 Then
 
 
 
 
 
    Chemin = "Chemin_ de_votre_fichier_image"
 
    Select Case Target
 
        Case Is <= -5: Fichier = "smiley_mauvais.gif"
 
        Case Is > 5: Fichier = "smiley_bon.gif"
 
        Case Else: Fichier = "smiley_egal.gif"
 
    End Select
 
    Worksheets("données").Image1.Picture = LoadPicture(Chemin & Fichier)
 
End If
 
End Sub