VBA - Bouton changement de couleur texte noir/rouge ou rouge/noir

Sub TEST()
    ActiveSheet.Unprotect (".")
    With Selection.Font
        If .ColorIndex = xlAutomatic Then
            .Color = -16776961
            .TintAndShade = 0
        Else
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
        End If
    End With
    ActiveSheet.Protect Password:=".", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Bonjour,

A moi que je n'ai pas compris votre demande, je ne vois pas le souci de votre code en sélectionnant plusieurs cellules.

Mettez votre bouton sur votre feuille et vous l'affectez à la macro test
Ensuite vous sélectionnez les cellules dont la couleur doit changer et vous cliquez sur votre bouton

Cordialement

Bonjour Dan,

C'est un petit détail mais lorsque vous sélectionnez pour la première fois un groupe de cellules, il faut cliquer 2x sur le bouton pour que le changement de couleur se fasse.

Cordialement

C'est un petit détail mais lorsque vous sélectionnez pour la première fois un groupe de cellules, il faut cliquer 2x sur le bouton pour que le changement de couleur se fasse.

Non du tout. Il faudrait savoir comment vous avez créé votre bouton ou mieux voir ce que vous avez dans votre fichier comme code

Bonjour Dan,

Je vous copie le code de la feuille car le fichier est trop volumineux pour être envoyé. Est-ce les autres codes qui pourraient poser problème?

Option Explicit

'Pour insérer 5 lignes vides en dessous de la cellule sélectionnée:

Sub insertion2()
    ActiveSheet.Unprotect Password:="."
    Application.EnableEvents = False
    ActiveCell.Offset(1, 0).EntireRow.Resize(5).Insert Shift:=xlDown
    Application.EnableEvents = True
    ActiveSheet.Protect Password:="."
End Sub

 'Pour insérer la date du jour dans la cellule sélectionnée:

Sub InsertDate()
    ActiveSheet.Unprotect Password:="."
    ActiveCell = Date
    ActiveSheet.Protect Password:="."
End Sub

'Pour imprimer la feuille sans les lignes vides:

Sub ImprimeSansVide()
    ActiveSheet.Unprotect Password:="."
    Dim Plage As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    With ActiveSheet
    Set Plage = .Range("C3:C250").Cells.SpecialCells(xlCellTypeBlanks)
    If Not Plage Is Nothing Then Plage.Rows.Hidden = True
    Set Plage = .Range("C251:C500").Cells.SpecialCells(xlCellTypeBlanks)
    If Not Plage Is Nothing Then Plage.Rows.Hidden = True
    Set Plage = .Range("C501:C750").Cells.SpecialCells(xlCellTypeBlanks)
    If Not Plage Is Nothing Then Plage.Rows.Hidden = True
    Set Plage = .Range("C751:C1000").Cells.SpecialCells(xlCellTypeBlanks)
    If Not Plage Is Nothing Then Plage.Rows.Hidden = True
    .PrintPreview 'pour voir sans imprimer
    '.PrintOut 'pour imprimer directement
    .Rows.Hidden = False
    End With
    ActiveSheet.Protect Password:="."
End Sub

' Masquer les lignes ou les cellules de la colonne F si elles sont remplies:

Sub masquer_ligne_vide_TEST2()
    ActiveSheet.Unprotect Password:="."
    Dim Cel As Range
    For Each Cel In ActiveSheet.Range("F3:F250").Cells
    If Cel <> vbNullString And Cel.Value <> "" Then
    Cel.EntireRow.Hidden = True
    End If
    Next
    ActiveSheet.Protect Password:="."
End Sub

' Afficher les lignes masquées:

Sub AfficherColonneLigne()
    ActiveSheet.Unprotect Password:="."
    Columns.EntireColumn.Hidden = False
    Rows.EntireRow.Hidden = False
    ActiveSheet.Protect Password:="."
End Sub

'Bouton changement de couleur texte noir/rouge rouge/noir

Sub BoutonCouleur()
    ActiveSheet.Unprotect (".")
    'Désactive le MDP
    With Selection.Font
        If .ColorIndex = xlAutomatic Then
        'Test si couleur noire par défaut
            .Color = -16776961
            'Couleur Rouge
            .TintAndShade = 0
        Else
            .ColorIndex = xlAutomatic
            'Couleur Noire
            .TintAndShade = 0
        End If
    End With
    ActiveSheet.Protect Password:=".", DrawingObjects:=True, Contents:=True, Scenarios:=True    'Réactive le MDP
End Sub

Dans un de vos codes je vois cette instruction --> Application.EnableEvents = False

Avez-vous des codes placés dans les feuilles de votre fichier

Cordialement

Navré mais je ne comprends pas votre question; mes feuilles sont verrouillées par le mot de passe "." mis à part les codes VBA ci-dessous, il n'y a pas d'autre code.

Le fichier fait 2 méga et le site ne permet que 1,5 sinon je vous l'aurait envoyé.

Je vais poser ma question autrement.

Est-ce les codes que vous avez placés ici sont bien tous dans un module ?

Ils sont tous sur de la Feuil 1 (projet). Le fichier ne comporte qu'un seul module avec ce code:

Function AUJOURDHUI_STATIC()
AUJOURDHUI_STATIC = Now
End Function

Essayez comme ceci

Sub BoutonCouleur()
    ActiveSheet.Unprotect (".")
    'Désactive le MDP
    With Selection.Font
        If .ColorIndex = xlAutomatic Or .Color = 0 Then
        'Test si couleur noire par défaut
            .Color = -16776961
            'Couleur Rouge
            .TintAndShade = 0
        Else
            .ColorIndex = xlAutomatic
            'Couleur Noire
            .TintAndShade = 0
        End If
    End With
    ActiveSheet.Protect Password:=".", DrawingObjects:=True, Contents:=True, Scenarios:=True    'Réactive le MDP
End Sub

Cela suppose qu'au départ la couleur est toujours en noir

Cordialement

Bonjour …

Si la sélection comporte les 2 couleurs, pour passer du noir au rouge ou du rouge au noir * :

Sub BoutonCouleur()
    Dim C As Range
    Me.Unprotect (".")
    For Each C In Selection              ‘boucle sur chaque cas
        C.Font.Color = IIf(C.Font.Color = vbRed, vbBlack, vbRed)
    Next
    Me.Protect Password:="."
End Sub

Nota : la sélection se fait sur des cellules non protégées au départ !

* information non données au départ. Dans le cas d’uniformité on n’a pas besoin de la boucle !

Sélection.Font.Color = IIf(selection.Font.Color = vbRed, vbBlack, vbRed)

ou voir la proposition de Dan (salut ).

Bonjour Dan et Ordonc,

Dan: votre code nécessite toujours un double clics sur le bouton lorsque plusieurs cellules sont sélectionnées.

Ordonc: votre code fonctionne parfaitement bien.

Merci beaucoup à vous deux pour votre aide si précieuse.

Je vous souhaite une bonne journée et vous adresse mes meilleures salutations.

Bonjour

Dan: votre code nécessite toujours un double clics sur le bouton lorsque plusieurs cellules sont sélectionnées.

Bah j'avais tout de même testé avant de poster et je n'ai pas eu de souci.

Ce que j'ai vu en fait c'est que si au départ la couleur de police dans la cellule de votre feuille n'est pas toujours Xlautomatic (exemple si vous avez défini une thème de couleur) le code passe d'abord par l'instruction ELSE qui elle, met la couleur en XLAutomatic. D'où pour mettre votre couleur vous devez recliquer sur votre bouton une deuxième fois.
Raison pour laquelle j'avais ajouté "color = 0" au départ du IF.

Ordonc a probablement dû voir la même chose ou penser autrement. Du coup il utilise une boucle dans la sélection et les couleurs RGB.

Vous pouvez essayer aussi en remplaçant xlautomatic par VbBlack comme ceci If .Color = vbBlack Then..... else .color = vbblack

Cordialement

Bonjour Dan,

Merci pour ces précisions.

Bon week-end!