XL 2010 Mise en forme conditionnelle dans zone de texte

F

FROMENTIN

XLDnaute Nouveau
Bonjour à vous,

Je suis actuellement entrain d'essayer de mettre en place une forme conditionnelle dans une zone de texte.

Pour être plus clair, je récupère une infirmation dans une autre feuil de mon classeur excel que j'intègre dans une zone de texte ( la formule donne "='nombre chantier en cours'!H1") l'information est bien récupéré mais j'aimerais lui attribuer une couleur en fonction du nombre qui apparaît.
N'étant pas très fort en VbA y a t'il une méthode pour me sauver de cette affaire facilement ?

Merci :)

Ps: Je ne peux malheureusement pas utiliser une cellule car sinon ça serait bien trop simple ;-)
 
Trier par date Trier par votes
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour FROMENTIN et bienvenue sur XLD :),

En lisant la charte du forum, vous avez dû raté le point 5 du chapitre "Demandeur" :
5 – La possibilité de joindre des fichiers est donnée sur ce forum. Ne pas hésiter à utiliser cette fonction, tout en veillant que les données soient bidons et donc qu’aucune donnée confidentielle, nominative ne soit dans le fichier.
Cliquez pour agrandir...

Je crains fort que peu de répondeurs ne se penchent sur votre question si vous ne joignez pas un fichier exemple : Quand vous éditer votre message , bouton plus d'options... puis bouton" Téléverser un fichier" )

A+
 
Vote positif 0 Vote négatif
phlaurent55

phlaurent55

Nous a quittés en 2020
Repose en paix
Bonjour à tous,

FROMENTIN à dit:
Pour être plus clair, je récupère une infirmation dans une autre feuil de mon classeur excel que j'intègre dans une zone de texte ( la formule donne "='nombre chantier en cours'!H1") l'information est bien récupéré mais j'aimerais lui attribuer une couleur en fonction du nombre qui apparaît.
Cliquez pour agrandir...

Si j'ai bien compris la demande il suffit de faire la MFC en fonction de la valeur de H1 et pas en fonction du contenu de la cellule qui contient la formule

à+
Philippe
 
Vote positif 0 Vote négatif
F

FROMENTIN

XLDnaute Nouveau
Merci beaucoup mapomme pour l'astuce.

Ci-joint un fichier exemple pour montrer ce que je souhaite.
Je souhaiterais que le smiley dans ma zone texte situé dans la feuille 1 reprenne les même couleur que le smiley dans la feuille 2.
Je ne sais pas si je suis très clair ...
Si la valeur est 2 dans ma feuille 2, le smiley de la feuille 2 devient donc orange mais celui de la feuille 1 reste vert.
Comment résoudre ce problème ?

Merci d'avance :)
 

Pièces jointes

  • test.xlsx
    15 KB · Affichages: 72
Vote positif 0 Vote négatif
L

Lolote83

XLDnaute Barbatruc
Bonjour à tous,
Un petit code qui permet de faire a priori ce que tu souhaites
Code: 
Sub CouleurZoneTexte()
    xVal = Sheets("Feuil2").[C1]
    ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        Select Case xVal
            Case Is = 1
                .ForeColor.RGB = RGB(0, 176, 80)    'VERT
            Case Is = 2
                .ForeColor.RGB = RGB(255, 192, 0)   'ORANGE
            Case Is = 3
                .ForeColor.RGB = RGB(255, 0, 0)     'ROUGE
        End Select
        .Transparency = 0
        .Solid
    End With
    [A1].Select
End Sub
@+ Lolote
 
Vote positif 0 Vote négatif
F

FROMENTIN

XLDnaute Nouveau
Genial ca à l'air de fonctionner.

Je vais tester ca sur le fichier original.

Existe-il un moyen pour que la couleur s'actualise toute seul ? Sans avoir a relancer le programme à chaque fois ?

Merci d'avance.

Désolé pour mon niveau en vba :/
 
Vote positif 0 Vote négatif
L

Lolote83

XLDnaute Barbatruc
Re salut,
Dans le code de la feuille1 mettre ceci
Ce code sera donc exécuté à l'activation de la feuille1
Code: 
Private Sub Worksheet_Activate()
    Call CouleurZoneTexte
End Sub

pour plus de clarté et de fluidité, remplace l'ancien code fourni par celui-ci
Code: 
Sub CouleurZoneTexte()
    Application.ScreenUpdating = False
    xVal = Sheets("Feuil2").[C1]
    ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        Select Case xVal
            Case Is = 1
                .ForeColor.RGB = RGB(0, 176, 80)    'VERT
            Case Is = 2
                .ForeColor.RGB = RGB(255, 192, 0)   'ORANGE
            Case Is = 3
                .ForeColor.RGB = RGB(255, 0, 0)     'ROUGE
        End Select
        .Transparency = 0
        .Solid
    End With
    Application.ScreenUpdating = True
    [A1].Select
End Sub
@+ Lolote83
 
Vote positif 0 Vote négatif
F

FROMENTIN

XLDnaute Nouveau
Salut Lolote83 et les autres :)

Voici donc le code que j'ai rentré dans mon fichier.
________________________________________________________________________
Private Sub Worksheet_Activate()
Call CouleurZoneTexte
End Sub
________________________________________________________________________
Sub CouleurZoneTexte()
Application.ScreenUpdating = False

xVal = Sheets("Satisfaction Client").[R7] ' NE FONCTIONNE PAS
ActiveSheet.Shapes.Range(Array("TextBox 14")).Select ' NE FONCTIONNE PAS
xVal = Sheets("Satisfaction Client").[R7] ' NE FONCTIONNE PAS
ActiveSheet.Shapes.Range(Array("TextBox 56")).Select ' NE FONCTIONNE PAS

xVal = Sheets("Satisfaction Client").[V7] ' NE FONCTIONNE PAS
ActiveSheet.Shapes.Range(Array("TextBox 16")).Select ' NE FONCTIONNE PAS
xVal = Sheets("Satisfaction Client").[V7] ' NE FONCTIONNE PAS
ActiveSheet.Shapes.Range(Array("TextBox 57")).Select ' NE FONCTIONNE PAS

xVal = Sheets("Satisfaction Client").[Z7] ' NE FONCTIONNE PAS
ActiveSheet.Shapes.Range(Array("TextBox 17")).Select ' NE FONCTIONNE PAS
xVal = Sheets("Satisfaction Client").[Z7] 'FONCTIONNE
ActiveSheet.Shapes.Range(Array("TextBox 58")).Select ' FONCTIONNE



With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
Select Case xVal
Case Is = 3
.ForeColor.RGB = RGB(0, 176, 80) 'VERT
Case Is = 2
.ForeColor.RGB = RGB(255, 192, 0) 'ORANGE
Case Is = 1
.ForeColor.RGB = RGB(255, 0, 0) 'ROUGE
End Select
.Transparency = 0
.Solid
End With
Application.ScreenUpdating = True
[A1].Select
End Sub
________________________________________________________________________
J'ai mis tous le code dans la page principal .
comme indiqué dedans seul ma dernière partie fonctionne...
Y a t'il une raison ?
Comment résoudre ce problème ?
 
Dernière édition:
Vote positif 0 Vote négatif
L

Lolote83

XLDnaute Barbatruc
Salut,
NE FONCTIONNE PAS : C'est normal car tu sélectionnes une a une les différentes shapes et tu appliques simplement à la dernière sélectionnées l'effet couleur.
Pour ce faire, il faut dissocier la partie Couleur de la partie selection.
En fait, ta macro sélectionne une shape, puis passe à l'autre, puis passe à une autre, jusqu'à la dernière et là, il y a coloriage. Cela se fait tellement vite que tu ne t'en aperçois même pas.

Un exemple :
Sub CouleurZoneTexte()
Application.ScreenUpdating = False

xVal = Sheets("Satisfaction Client").[R7]
ActiveSheet.Shapes.Range(Array("TextBox 14")).Select
call couleur

xVal = Sheets("Satisfaction Client").[R7]
ActiveSheet.Shapes.Range(Array("TextBox 56")).Select
call couleur

xVal = Sheets("Satisfaction Client").[V7]
ActiveSheet.Shapes.Range(Array("TextBox 16")).Select
call couleur

etc etc etc
end sub

avec le code couleur
Sub Coloriage
With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
Select Case xVal
Case Is = 3
.ForeColor.RGB = RGB(0, 176, 80) 'VERT
Case Is = 2
.ForeColor.RGB = RGB(255, 192, 0) 'ORANGE
Case Is = 1
.ForeColor.RGB = RGB(255, 0, 0) 'ROUGE
End Select
.Transparency = 0
.Solid
End With
end sub

J'espère avoir été clair.
@+ Lolote83
 
Vote positif 0 Vote négatif
F

FROMENTIN

XLDnaute Nouveau
Bonjour à vous.
Désolé de relancer le sujet c'est un sujet qui était en Standbye pour moi et j'ai le temps actuellement de m'y remettre .. :)

Malhereusement cela ne fonctionne toujours pas....
Ci-joint mon code:
"
Private Sub Worksheet_Activate()
Call CouleurZoneTexte
End Sub

Sub CouleurZoneTexte()
Application.ScreenUpdating = False

xVal = Sheets("Satisfaction Client").[R7]
ActiveSheet.Shapes.Range(Array("TextBox 14")).Select
Call Coloriage

xVal = Sheets("Satisfaction Client").[R7]
ActiveSheet.Shapes.Range(Array("TextBox 56")).Select
Call Coloriage

xVal = Sheets("Satisfaction Client").[V7]
ActiveSheet.Shapes.Range(Array("TextBox 57")).Select
Call Coloriage

xVal = Sheets("Satisfaction Client").[V7]
ActiveSheet.Shapes.Range(Array("TextBox 16")).Select
Call Coloriage

xVal = Sheets("Satisfaction Client").[Z7]
ActiveSheet.Shapes.Range(Array("TextBox 58")).Select
Call Coloriage

xVal = Sheets("Satisfaction Client").[Z7]
ActiveSheet.Shapes.Range(Array("TextBox 17")).Select
Call Coloriage

xVal = Sheets("nombre chantier en cours").[B5]
ActiveSheet.Shapes.Range(Array("TextBox 88")).Select
Call Coloriage

xVal = Sheets("nombre chantier en cours").[B5]
ActiveSheet.Shapes.Range(Array("TextBox 11")).Select
Call Coloriage

xVal = Sheets("nombre chantier en cours").[E5]
ActiveSheet.Shapes.Range(Array("TextBox 83")).Select
Call Coloriage

xVal = Sheets("nombre chantier en cours").[E5]
ActiveSheet.Shapes.Range(Array("TextBox 79")).Select
Call Coloriage

xVal = Sheets("nombre chantier en cours").[H5]
ActiveSheet.Shapes.Range(Array("TextBox 89")).Select
Call Coloriage

xVal = Sheets("nombre chantier en cours").[H5]
ActiveSheet.Shapes.Range(Array("TextBox 80")).Select
Call Coloriage

End Sub


Sub Coloriage()
With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
Select Case xVal
Case Is = 3
.ForeColor.RGB = RGB(0, 176, 80) 'VERT
Case Is = 2
.ForeColor.RGB = RGB(255, 192, 0) 'ORANGE
Case Is = 1
.ForeColor.RGB = RGB(255, 0, 0) 'ROUGE
End Select
.Transparency = 0
.Solid
End With
Application.ScreenUpdating = True
[A1].Select
End Sub
"

Des idées ?

Merci d'avance :D
 
Vote positif 0 Vote négatif

Discussions similaires

J
  • Question
mise en forme conditionnelle
Réponses
2
Affichages
147
sylvanu
sylvanu
K
  • Question
Microsoft 365 Mise en forme conditionnelle
Réponses
5
Affichages
144
job75
job75
jeanmi
  • Question
XL 2010 mise en forme conditionnelle
Réponses
2
Affichages
240
jeanmi
jeanmi
L
  • Résolu(e)
XL 2016 mise en forme conditionnelle
Réponses
2
Affichages
244
litchoutsou
L
@
  • Résolu(e)
Microsoft 365 mise en forme conditionnelle
Réponses
12
Affichages
198
@lea
@
P
  • Résolu(e)
Microsoft 365 Mise en forme conditionnelle
Réponses
5
Affichages
235
Peter 50
P
P
  • Question
XL 2019 Mise en forme conditionnelle sur plusieurs feuilles
Réponses
6
Affichages
264
JHA
J
D
  • Question
XL 2019 Mise en forme conditionnelle semaine glissante
Réponses
12
Affichages
250
DST
D
F
  • Résolu(e)
Microsoft 365 Mise en forme conditionnelle selon la référence d'une cellule
Réponses
3
Affichages
99
filiph79
F
J
  • Question
XL 2021 mise en forme conditionnelle et cellules vides.
Réponses
2
Affichages
181
JOGA
J

Membres actuellement en ligne

12 membres et 108 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 111
Messages
2 085 396
Membres
102 882
dernier inscrit
Sultan94