Menu

Image qui change en fonction du contenu de la cellule active [Résolu]

Messages postés
10
Date d'inscription
mardi 13 juin 2017
Dernière intervention
6 mars 2019
- - Dernière réponse : Woochi
Messages postés
10
Date d'inscription
mardi 13 juin 2017
Dernière intervention
6 mars 2019
- 6 mars 2019 à 10:26
Bonjour, je voudrait faire un code vba qui permet de changer une image en fonction du contenu de la cellule active.

J'ai réussit à rédiger le code ci-dessous (en l'adaptant d'un code trouvé sur internet).
L'image est en background d'un objet-forme.

1/ J'ai un problème sur la sélection de l'objet-forme.
Lorsque je clic sur une cellule contenant le "texte1" par exemple, l'objet-forme se sélectionne automatiquement et je voudrait éviter cela car je voudrait que ma cellule active reste sélectionnée.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Déclaration de la variable qui contient le chemin des images
Dim PathDossierImage As String
PathDossierImage = "C:\images\"

If Target.Cells.Count > 1 Then Exit Sub
' Application.ScreenUpdating = False
' Réinitialise en blanc la conteneur de l'image

' Condition de la ellule active
If ActiveCell.Value Like "*texte1*" Then
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 3")).Select
With Selection.ShapeRange.Fill
.UserPicture _
PathDossierImage & "1.png"
End With
End If

If ActiveCell.Value Like "*texte2*" Then
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 3")).Select
With Selection.ShapeRange.Fill
.UserPicture _
PathDossierImage & "2.png"
End With
End If

' Application.ScreenUpdating = True
End Sub



2/ Dans le code que j'ai trouvé il y avait "Application.ScreenUpdating = False" mais je ne sait pas si il est bien utile, ni à quoi il sert, car le code fonctionne sans... Est-ce que je doit le gardé ?

3/ C'est la seul méthode que j'ai trouvé pour faire changer une image en fonction d'un contenu de cellule. Mais si il existe une autre méthode plus simple pour arrivé à faire ce genre de chose, je suis preneur.

merci d'avance pour vos réponses.
Afficher la suite 

Votre réponse

1 réponse

Meilleure réponse
Messages postés
1895
Date d'inscription
lundi 3 mai 2010
Dernière intervention
21 mars 2019
132
1
Merci
Bonjour,

1/ C'est l'instruction Select qui sélectionne ta forme. Je pense que tu peux raccourcir ainsi :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Déclaration de la variable qui contient le chemin des images
Dim PathDossierImage As String
PathDossierImage = "C:\images\"

If Target.Cells.Count > 1 Then Exit Sub

' Condition de la ellule active
If ActiveCell.Value Like "*texte1*" Then ActiveSheet.Shapes.Range(Array("Rounded Rectangle 3")).Fill.UserPicture PathDossierImage & "2.png"

If ActiveCell.Value Like "*texte2*" Then ActiveSheet.Shapes.Range(Array("Rounded Rectangle 3")).Fill.UserPicture PathDossierImage & "2.png"

End Sub

2/ ça sert à ne pas mettre à jour l'affichage. En pratique, ça sert à éviter les clignotements quand il y a beaucoup d'opérations qui sont effectuées.
3/ voir 1

A+

Dire « Merci » 1

Heureux de vous avoir aidé ! Vous nous appréciez ? Donnez votre avis sur nous ! Evaluez CommentCaMarche

CCM 47519 internautes nous ont dit merci ce mois-ci

Woochi
Messages postés
10
Date d'inscription
mardi 13 juin 2017
Dernière intervention
6 mars 2019
-
Encore une fois Merci Zoul67, tu me sort une épine du pied. J'avais compris d'où venait l'erreur, mais je n'arrivais pas à la résoudre.
Ton code fonctionne très bien sauf si la cellule active renvoie une erreur.
J'ai écrit "=nb" par erreur dans une cellule et là j'ai eu un msg d'erreur sur le code... je pense qu'il faudrait rajouté une condition si la cellule ne contient pas d'erreur... mais je ne sait pas faire.
Est-ce que tu peux qqch pour moi ?
Zoul67
Messages postés
1895
Date d'inscription
lundi 3 mai 2010
Dernière intervention
21 mars 2019
132 -
Comme ça ?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Déclaration de la variable qui contient le chemin des images
Dim PathDossierImage As String
PathDossierImage = "C:\images\"

If Target.Cells.Count > 1 Then Exit Sub

On Error GoTo ErrHandler:
' Condition de la cellule active
If ActiveCell.Value Like "*texte1*" Then ActiveSheet.Shapes.Range(Array("Rounded Rectangle 3")).Fill.UserPicture PathDossierImage & "1.png"

If ActiveCell.Value Like "*texte2*" Then ActiveSheet.Shapes.Range(Array("Rounded Rectangle 3")).Fill.UserPicture PathDossierImage & "2.png"

ErrHandler:
End Sub
Woochi
Messages postés
10
Date d'inscription
mardi 13 juin 2017
Dernière intervention
6 mars 2019
-
OK, Merci, c'est parfait ça marche impeccable !
Commenter la réponse de Zoul67