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

Signaler
Messages postés
13
Date d'inscription
mardi 13 juin 2017
Statut
Membre
Dernière intervention
20 mai 2020
-
Messages postés
13
Date d'inscription
mardi 13 juin 2017
Statut
Membre
Dernière intervention
20 mai 2020
-
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.

1 réponse

Messages postés
1938
Date d'inscription
lundi 3 mai 2010
Statut
Membre
Dernière intervention
11 mai 2020
131
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+
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 79988 internautes nous ont dit merci ce mois-ci

Messages postés
13
Date d'inscription
mardi 13 juin 2017
Statut
Membre
Dernière intervention
20 mai 2020

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 ?
Messages postés
1938
Date d'inscription
lundi 3 mai 2010
Statut
Membre
Dernière intervention
11 mai 2020
131
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
Messages postés
13
Date d'inscription
mardi 13 juin 2017
Statut
Membre
Dernière intervention
20 mai 2020

OK, Merci, c'est parfait ça marche impeccable !