Afficher des images diférentes en fonction du résultat d'une cellule.

Le
Changuy
Bonjour à tous,

Je débute dans la programmation en VBA Excel et j'ai besoin d'aide sur un
petit problème.

Le problème de départ est le suivant:
Je souhaite afiicher un dessin différent en fonction du résultat d'une
cellule.
Exemple simple avec des notes d'élève,
si la note est inférieure à 10, afficher une tête de bonhomme triste rouge
si la note est supérieure à 10, afficher une tête sourirante et verte !

Pour faire quelques essais, j'ai créé 2 dessins que j'ai nommé "DESSIN A" et
"DESSIN B" .
Ils sont placés dans la 'Feuil1' (regroupement de plusieurs formes traits,
cercle, rectangle ..)
J'ai positionné en feuil2 une liste déroulante permettant un choix entre la
valeur "A" et "B".
Le résultat de cette "liste déroulante" est affiché dans la cellule
C8.(Cellule Liée)
Le but est d'afficher le "DESSIN A" lorsque "A" est sélectionné dans la
liste déroulante et inversement pour "B".
Voici le code que j'ai developper après quelques recherches:
(Cette macro est affectée à la liste déroulante)

Dim img As Object

For Each img In Sheets("Feuil2").Shapes
If img.Name = "DESSIN A" Or img.Name = "DESSIN B" Then
' Ce test est nécessaire sinon je suprime tous les dessin y
compris la liste déroulante ???? je ne comprend pas pourqoi !
img.Delete
End If
Next

If Range("C8") = 1 Then
Sheets("Feuil1").Select
ActiveSheet.Shapes("DESSIN A").Select
Selection.Copy
Sheets("Feuil2").Select
Range("F7").Select
ActiveSheet.Paste
End If

If Range("C8") = 2 Then
Sheets("Feuil1").Select
ActiveSheet.Shapes("DESSIN B").Select
Selection.Copy
Sheets("Feuil2").Select
Range("F7").Select
ActiveSheet.Paste
End If

End Sub

Ya-t il des moyens plus simple pour obtenir le même résultat ?
Cette macro est elle affecter à une cellule?

Je vous remercie de votre aide par avance.

JC
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel
Le #4943841
Bonsoir.
Utilise les caractères J et L avec la police wingdings et la couleur
appropriée.
=SI(A1<10;"J";"L")
Cordialement.
Daniel
"Changuy"
Bonjour à tous,

Je débute dans la programmation en VBA Excel et j'ai besoin d'aide sur un
petit problème.

Le problème de départ est le suivant:
Je souhaite afiicher un dessin différent en fonction du résultat d'une
cellule.
Exemple simple avec des notes d'élève,
si la note est inférieure à 10, afficher une tête de bonhomme triste rouge
si la note est supérieure à 10, afficher une tête sourirante et verte !

Pour faire quelques essais, j'ai créé 2 dessins que j'ai nommé "DESSIN A"
et "DESSIN B" .
Ils sont placés dans la 'Feuil1' (regroupement de plusieurs formes traits,
cercle, rectangle ..)
J'ai positionné en feuil2 une liste déroulante permettant un choix entre
la valeur "A" et "B".
Le résultat de cette "liste déroulante" est affiché dans la cellule
C8.(Cellule Liée)
Le but est d'afficher le "DESSIN A" lorsque "A" est sélectionné dans la
liste déroulante et inversement pour "B".
Voici le code que j'ai developper après quelques recherches:
(Cette macro est affectée à la liste déroulante)

Dim img As Object

For Each img In Sheets("Feuil2").Shapes
If img.Name = "DESSIN A" Or img.Name = "DESSIN B" Then
' Ce test est nécessaire sinon je suprime tous les dessin y
compris la liste déroulante ???? je ne comprend pas pourqoi !
img.Delete
End If
Next

If Range("C8") = 1 Then
Sheets("Feuil1").Select
ActiveSheet.Shapes("DESSIN A").Select
Selection.Copy
Sheets("Feuil2").Select
Range("F7").Select
ActiveSheet.Paste
End If

If Range("C8") = 2 Then
Sheets("Feuil1").Select
ActiveSheet.Shapes("DESSIN B").Select
Selection.Copy
Sheets("Feuil2").Select
Range("F7").Select
ActiveSheet.Paste
End If

End Sub

Ya-t il des moyens plus simple pour obtenir le même résultat ?
Cette macro est elle affecter à une cellule?

Je vous remercie de votre aide par avance.

JC





Duarrab81
Le #4943831
Bonjour,
Une réponse très simple (simpliste ?!) est d'utiliser dans chaque cellule où
doit s'afficher le "bonhomme" le formule conditionnelle suivante :

=SI(B1>10;"J";"L")

toutes les cellules doivent être au format Wingdings.

Salut

"Changuy"
Bonjour à tous,

Je débute dans la programmation en VBA Excel et j'ai besoin d'aide sur un
petit problème.

Le problème de départ est le suivant:
Je souhaite afiicher un dessin différent en fonction du résultat d'une
cellule.
Exemple simple avec des notes d'élève,
si la note est inférieure à 10, afficher une tête de bonhomme triste rouge
si la note est supérieure à 10, afficher une tête sourirante et verte !

Pour faire quelques essais, j'ai créé 2 dessins que j'ai nommé "DESSIN A"
et "DESSIN B" .
Ils sont placés dans la 'Feuil1' (regroupement de plusieurs formes traits,
cercle, rectangle ..)
J'ai positionné en feuil2 une liste déroulante permettant un choix entre
la valeur "A" et "B".
Le résultat de cette "liste déroulante" est affiché dans la cellule
C8.(Cellule Liée)
Le but est d'afficher le "DESSIN A" lorsque "A" est sélectionné dans la
liste déroulante et inversement pour "B".
Voici le code que j'ai developper après quelques recherches:
(Cette macro est affectée à la liste déroulante)

Dim img As Object

For Each img In Sheets("Feuil2").Shapes
If img.Name = "DESSIN A" Or img.Name = "DESSIN B" Then
' Ce test est nécessaire sinon je suprime tous les dessin y
compris la liste déroulante ???? je ne comprend pas pourqoi !
img.Delete
End If
Next

If Range("C8") = 1 Then
Sheets("Feuil1").Select
ActiveSheet.Shapes("DESSIN A").Select
Selection.Copy
Sheets("Feuil2").Select
Range("F7").Select
ActiveSheet.Paste
End If

If Range("C8") = 2 Then
Sheets("Feuil1").Select
ActiveSheet.Shapes("DESSIN B").Select
Selection.Copy
Sheets("Feuil2").Select
Range("F7").Select
ActiveSheet.Paste
End If

End Sub

Ya-t il des moyens plus simple pour obtenir le même résultat ?
Cette macro est elle affecter à une cellule?

Je vous remercie de votre aide par avance.

JC





JB
Le #4943641
Bonjour,

http://boisgontierjacques.free.fr/fichiers/MFC/MFCImages.xls

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 8 Then
'-- suppression
For Each s In ActiveSheet.Shapes
If s.Type = 13 Then
If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
s.Delete
End If
End If
Next s
'--
Sheets("status").Shapes(Application.Substitute(Target, " ",
"")).Copy
Target.Offset(0, 1).Select
ActiveSheet.Paste
Selection.ShapeRange.Left = ActiveCell.Left + 9
Selection.ShapeRange.Top = ActiveCell.Top + 5
Target.Select
End If
End Sub

JB

On 29 mai, 22:04, "Changuy"
Bonjour à tous,

Je débute dans la programmation en VBA Excel et j'ai besoin d'aide sur un
petit problème.

Le problème de départ est le suivant:
Je souhaite afiicher un dessin différent en fonction du résultat d'une
cellule.
Exemple simple avec des notes d'élève,
si la note est inférieure à 10, afficher une tête de bonhomme trist e rouge
si la note est supérieure à 10, afficher une tête sourirante et ver te !

Pour faire quelques essais, j'ai créé 2 dessins que j'ai nommé "DES SIN A" et
"DESSIN B" .
Ils sont placés dans la 'Feuil1' (regroupement de plusieurs formes trai ts,
cercle, rectangle ..)
J'ai positionné en feuil2 une liste déroulante permettant un choix e ntre la
valeur "A" et "B".
Le résultat de cette "liste déroulante" est affiché dans la cellule
C8.(Cellule Liée)
Le but est d'afficher le "DESSIN A" lorsque "A" est sélectionné dans la
liste déroulante et inversement pour "B".
Voici le code que j'ai developper après quelques recherches:
(Cette macro est affectée à la liste déroulante)

Dim img As Object

For Each img In Sheets("Feuil2").Shapes
If img.Name = "DESSIN A" Or img.Name = "DESSIN B" Then
' Ce test est nécessaire sinon je suprime tous les dessin y
compris la liste déroulante ???? je ne comprend pas pourqoi !
img.Delete
End If
Next

If Range("C8") = 1 Then
Sheets("Feuil1").Select
ActiveSheet.Shapes("DESSIN A").Select
Selection.Copy
Sheets("Feuil2").Select
Range("F7").Select
ActiveSheet.Paste
End If

If Range("C8") = 2 Then
Sheets("Feuil1").Select
ActiveSheet.Shapes("DESSIN B").Select
Selection.Copy
Sheets("Feuil2").Select
Range("F7").Select
ActiveSheet.Paste
End If

End Sub

Ya-t il des moyens plus simple pour obtenir le même résultat ?
Cette macro est elle affecter à une cellule?

Je vous remercie de votre aide par avance.

JC


Publicité
Poster une réponse
Anonyme