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

Titi456 · 6 Février 2023

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.

VB:

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 · 6 Février 2023

Bonjour.
Ben ajoutez :

VB:

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

patricktoulon · 6 Février 2023

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

job75 · 6 Février 2023

Bonjour Titi456, Bernard, Patrick,

Dans le code de la feuille :

VB:

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 · 6 Février 2023

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 · 6 Février 2023

Titi456 à dit:
@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 :

VB:

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 · 6 Février 2023

job75 à dit:

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

VB:

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.

VB:

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 · 6 Février 2023

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

Titi456 · 7 Février 2023

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 · 7 Février 2023

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 :

VB:

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 · 8 Février 2023

Bonjour,

Voici le code que je cherchais:

VB:

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 · 8 Février 2023

Bonjour,

Titi456 à dit:
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+

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

Titi456

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Titi456

XLDnaute Junior

job75

XLDnaute Barbatruc

Pièces jointes

Titi456

XLDnaute Junior

job75

XLDnaute Barbatruc

Titi456

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Titi456

XLDnaute Junior

job75

XLDnaute Barbatruc

Discussions similaires