XL 2010 VBA - Bouton changement couleur texte rouge/vert/bleu/noir

[tchi456]

Bonjour,

Je souhaite créer un bouton pour pouvoir changer la couleur du texte de la/des cellule(s) sélectionnée(s).
Premier clic le texte devient rouge, deuxième clic le texte devient vert, troisième clic le texte devient bleu et quatrième clic le texte redevient noir.
Si cela est possible j'aimerai également que le texte de mon bouton change à chaque clic; "R" avant le premier clic, "V" après le premier clic, "B" après le deuxième clic, "N" après le troisième clic et redevienne "R" après le quatrième clic.

Pouvez-vous m'aider?

Mes meilleures salutations,

Thierry

 

[Phil69970]

Bonjour @tchi456

Si j'ai bien compris l'ordre des couleurs sinon c'est juste une permutation des couleur à faire !

Private Sub CommandButton1_Click()
Dim Coul
Coul = ActiveCell.Font.Color
Select Case Coul
    Case vbBlack
        ActiveCell.Font.Color = vbRed
        CommandButton1.Caption = "R"
        CommandButton1.ForeColor = vbRed
    Case vbRed
        ActiveCell.Font.Color = vbGreen
        CommandButton1.Caption = "V"
        CommandButton1.ForeColor = vbGreen
    Case vbGreen
        ActiveCell.Font.Color = vbBlue
        CommandButton1.Caption = "B"
        CommandButton1.ForeColor = vbBlue
    Case vbBlue
        ActiveCell.Font.Color = vbBlack
        CommandButton1.Caption = "N"
        CommandButton1.ForeColor = vbBlack
End Select
End Sub

*Merci de ton retour

@Phil69970

 

[tchi456]

Bonjour Phil69970,

Vous êtes sur tous les fronts. Votre code m'a l'air correct mais je comprends pas la raison pour laquelle il ne fonctionne pas.

Meilleures salutations,

Thierry

 

[Phil69970]

Re

1)Une shape rectangle n'est pas un bouton comme dans la demande initial😜

2)Il y a qui aime bien se faire mal un bouton de commande est si pratique et en plus fait pour cela 🙃

3)Moralité de l'histoire :
-Dans la demande initial mets les bons mots ou fournit un fichier.... 👍
-Utilise les bons "boutons" qui sont étudiés pour.😉

Option Explicit

'Bouton pour changer la couleur du texte

Sub BoutonChangerCouleurTexte()
        ActiveSheet.Unprotect Password:="."
    Dim Coul
Coul = ActiveCell.Font.Color
Select Case Coul
    Case vbBlack
        ActiveCell.Font.Color = vbRed
        Shapes.Range(Array("Rectangle 1")).TextFrame2.TextRange.Characters.Text = "R"
        Shapes.Range(Array("Rectangle 1")).TextFrame2.TextRange.Characters(1, 1).Font.Fill.ForeColor.RGB = vbRed
    Case vbRed
        ActiveCell.Font.Color = vbGreen
        Shapes.Range(Array("Rectangle 1")).TextFrame2.TextRange.Characters.Text = "V"
        Shapes.Range(Array("Rectangle 1")).TextFrame2.TextRange.Characters(1, 1).Font.Fill.ForeColor.RGB = vbGreen
    Case vbGreen
        ActiveCell.Font.Color = vbBlue
        Shapes.Range(Array("Rectangle 1")).TextFrame2.TextRange.Characters.Text = "B"
        Shapes.Range(Array("Rectangle 1")).TextFrame2.TextRange.Characters(1, 1).Font.Fill.ForeColor.RGB = vbBlue
    Case vbBlue
        ActiveCell.Font.Color = vbBlack
        Shapes.Range(Array("Rectangle 1")).TextFrame2.TextRange.Characters.Text = "N"
        Shapes.Range(Array("Rectangle 1")).TextFrame2.TextRange.Characters(1, 1).Font.Fill.ForeColor.RGB = vbBlack
End Select
    ActiveSheet.Protect Password:="."
End Sub

et en plus court

Option Explicit

'Bouton pour changer la couleur du texte

Sub BoutonChangerCouleurTexte()
        ActiveSheet.Unprotect Password:="."
    Dim Coul
Coul = ActiveCell.Font.Color
With Shapes.Range(Array("Rectangle 1")).TextFrame2.TextRange
    Select Case Coul
            Case vbBlack
                ActiveCell.Font.Color = vbRed
                .Characters.Text = "R"
                .Characters(1, 1).Font.Fill.ForeColor.RGB = vbRed
            Case vbRed
                ActiveCell.Font.Color = vbGreen
                .Characters.Text = "V"
                .Characters(1, 1).Font.Fill.ForeColor.RGB = vbGreen
            Case vbGreen
                ActiveCell.Font.Color = vbBlue
                .Characters.Text = "B"
                .Characters(1, 1).Font.Fill.ForeColor.RGB = vbBlue
            Case vbBlue
                ActiveCell.Font.Color = vbBlack
                .Characters.Text = "N"
                .Characters(1, 1).Font.Fill.ForeColor.RGB = vbBlack
    End Select
End With
    ActiveSheet.Protect Password:="."
End Sub

*Ce code fonctionne avec le fichier fournit

*Merci de ton retour

@Phil69970

 

[tchi456]

Re bonjour Phil69970,

Vous êtes un bon. Votre code fonctionne parfaitement bien.

Merci beaucoup pour votre aide.

Bon appétit !