Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Titi456

XLDnaute Junior
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
 

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Classeur(1).xlsm
    17.6 KB · Affichages: 3

Titi456

XLDnaute Junior
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

XLDnaute Barbatruc
@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
 

Pièces jointes

  • Classeur(2).xlsm
    23.1 KB · Affichages: 1

Titi456

XLDnaute Junior
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
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
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.
 
Dernière édition:

Titi456

XLDnaute Junior
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…