XL 2010 Mise en forme conditionnelle dans zone de texte

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 ;-)
 

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.

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+
 

phlaurent55

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

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.

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
 

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

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
 

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 :/
 

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
 

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:

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
 

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
 

Discussions similaires

Statistiques des forums

Discussions
315 095
Messages
2 116 167
Membres
112 675
dernier inscrit
Tazra_IMOU