XL 2010 VBA - Bouton mettre en rouge plusieurs cellules sur la ligne de la cellule sélectionnée

[Titi456]

Bonjour,

J'ai ce code pour pouvoir mettre en rouge et inversément le texte de n'importe quelle cellule sélectionnée cependant je souhaiterais l'adapter pour que quand une cellule de la zone A5: D54 est sélectionnée, cela mette le texte en rouge ma cellule sélectionnée mais également les cellules de la même ligne des colonnes A à D uniquement.

Sub BoutonTexteCouleurRouge()
    Dim C As Range
    ActiveSheet.Unprotect Password:="."
    For Each C In Selection
        C.Font.Color = IIf(C.Font.Color = vbRed, vbBlack, vbRed)
    Next
    ActiveSheet.Protect Password:="."
End Sub

Pouvez-vous m'aider?

Mes meilleures salutations,

Thierry

 

[Dranreb]

Bonjour.
Ben ajoutez :

      Intersect(ActiveSheet.[A:D], C.EntireRow).Font.Color = C.Font.Color

 

[patricktoulon]

re
et quand tu la deselectionne ou selectionne une autre doit elle reprendre la couleur noire

 

[job75]

Bonjour Titi456, Bernard, Patrick,

Dans le code de la feuille :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Protect Password:=".", UserInterfaceOnly:=True
With [A5:D54]
    .Font.ColorIndex = xlAutomatic 'RAZ
    If Not Intersect(ActiveCell, .Cells) Is Nothing Then _
        Intersect(ActiveCell.EntireRow, .Cells).Font.ColorIndex = 3 'rouge
End With
End Sub

A+

 

[Titi456]

Bonjour Bernard, Patrick, Job,

Merci pour vos proposition,

@Bernard je n'arrive pas à faire fonctionner votre code mais il m'a l'air intéressant.
@job votre code fonctionne bien mais il remet en noir toutes les autres cellules et ne permet pas de remettre en noir si la cellule sélectionnée est en rouge.

Meilleures salutations,

Thierry

 

[job75]

@job votre code fonctionne bien mais il remet en noir toutes les autres cellules et ne permet pas de remettre en noir si la cellule sélectionnée est en rouge.

Alors disons que la sélection colore en rouge et que le bouton RAZ efface toutes les couleurs de police :

Private Sub CommandButton1_Click() 'bouton RAZ
Protect Password:=".", UserInterfaceOnly:=True
[A5:D54].Font.ColorIndex = xlAutomatic
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Protect Password:=".", UserInterfaceOnly:=True
With [A5:D54]
    If Not Intersect(ActiveCell, .Cells) Is Nothing Then _
        Intersect(ActiveCell.EntireRow, .Cells).Font.ColorIndex = 3 'rouge
End With
End Sub

 

[Titi456]

Alors disons que la sélection colore en rouge et que le bouton RAZ efface toutes les couleurs de police :

Private Sub CommandButton1_Click() 'bouton RAZ
Protect Password:=".", UserInterfaceOnly:=True
[A5:D54].Font.ColorIndex = xlAutomatic
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Protect Password:=".", UserInterfaceOnly:=True
With [A5:D54]
    If Not Intersect(ActiveCell, .Cells) Is Nothing Then _
        Intersect(ActiveCell.EntireRow, .Cells).Font.ColorIndex = 3 'rouge
End With
End Sub

Re bonjour,

C'est parfait malheureusement lorsque je reclique sur mon bouton il ne remet pas le texte en noir.
Je souhaiterais pouvoir faire l'opération inverse lorsque je clique une seconde fois.

Sub BoutonTexteCouleurRouge()
    Dim C As Range
    ActiveSheet.Unprotect Password:="."
With [A5:D54]
    If Not Intersect(ActiveCell, .Cells) Is Nothing Then _
        Intersect(ActiveCell.EntireRow, .Cells).Font.ColorIndex = 3 'rouge
End With
    ActiveSheet.Protect Password:="."
End Sub

 

[job75]

Ce n'est pas le code que j'ai donné, le bouton RAZ ne sert qu'à effacer.

 

[Titi456]

Bonjour,

Merci beaucoup pour votre aide mais je n'arrive malgré tout pas à faire fonctionner mon bouton comme je l'entends.

Bonne journée

 

[Dranreb]

Bonjour.
Joignez le classeur avec le code que vous avez essayé d'adapter.
Remarquez, selon la façon dont il fallait comprendre la demande, peut être suffit-il de mettre au début :

If Not Intersect([A5:D54], Selection) Is Nothing Then Intersect([A:D], Selection.EntireRow).Select

Ça dépend s'il s'agit d'effectuer la même opération sur ces cellule plutôt que de reporter sur elles la couleur corrigée de la seule cellule sélectionnée comme je le croyais.

 

[Titi456]

Bonjour,

Voici le code que je cherchais:

Sub BoutonTexteCouleurRouge()
  Dim Lig As Long
  If Not Intersect(Selection, Range("A5:D54")) Is Nothing Then
    ActiveSheet.Unprotect Password:="."
    Lig = Selection.Row
    With Range("A" & Lig & ":D" & Lig)
      .Font.Color = IIf(.Font.Color = vbRed, vbBlack, vbRed)
    End With
    ActiveSheet.Protect Password:="."
  End If
End Sub

Meilleures salutations,

Thierry

 

[job75]

Bonjour,

Voici le code que je cherchais:

Je ne pense pas car si vous sélectionnez la plage A1: D5 c'est la plage A1: D1 qui sera colorée.

A+