Coloration de cellules - Page 2

Re
C'est bien celà pour les quatre qui sont dans la même colonne,mais il y a aussi les deux autres:
BX174:BX234
CV174:CV234

Comme j'utilise la bicoloration sur d'autres tableaux,dans le même feuillet,sans les colorier en rouge tous les mois,il suffirait d'adapter la première partie du code aux plages ci-dessus,sans modifier le code utilisé actuellement dans tout le feuillet.,pour le bicolore.

A +

Re,

Voila tes codes, dis mois dans toutes les cellules y a t il des données comme dans la première série K8 à K70, si oui même une formule, je mettrais un détrompeur pour éviter de coloriser les cellules intermédiaires. la nuit porte conseil je vais y réfléchir

Private Sub CommandButton2_Click()
Dim x As Range
For Each x In Range("Q8:Q70,BB46: BB106,BB110: BB170,BB174: BB234,BB240: BB300,BX174: BX234,CV174: CV234")
If x.Interior.ColorIndex <> xlNone Then
x.Interior.ColorIndex = 3
End If
Next x
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Selection, Range("Q8:Q70,BB46: BB106,BB110: BB170,BB174: BB234,BB240: BB300,BX174: BX234,CV174: CV234")) Is Nothing Then
If Target.Interior.ColorIndex = 3 Then
With Selection.Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 45
.Gradient.ColorStops.Clear
End With
With Selection.Interior.Gradient.ColorStops.Add(0)
.Color = 16777164
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(0.45)
.Color = 16777164
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(0.55)
.Color = 10092543
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.Color = 10092543
.TintAndShade = 0
End With
Cancel = True
End If
End If
End Sub

re
Bonsoir Mike

Excuse mon silence,ai été absent depuis hier soir,et découvre tes codes en rentrant,ce soir.

Je vais les mettre en place demain et te dirai ce qu'il en est.

Pour répondre à ta question,oui,il y a des données identiques dans tous ces tableaux.

A demain ,bonne nuit,et merci.

micbre

Re,

Alors si tu as des données ou formules dans les cellules à surveiller il vaut mieux compléter le code afin d'éviter que les cellules intermédiares se colorisent testes plutôt ces codes, à copier à la place des autres, fais attention au nom du bouton

Private Sub CommandButton1_Click()
Dim x As Range
For Each x In Range("Q8:Q70,BB46: BB106,BB110: BB170,BB174: BB234,BB240: BB300,BX174: BX234,CV174: CV234")
If x <> "" And x.Interior.ColorIndex <> xlNone Then
x.Interior.ColorIndex = 3
End If
Next x
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Selection, Range("Q8:Q70,BB46: BB106,BB110: BB170,BB174: BB234,BB240: BB300,BX174: BX234,CV174: CV234")) Is Nothing Then
If Target <> "" And Target.Interior.ColorIndex = 3 Then
With Selection.Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 45
.Gradient.ColorStops.Clear
End With
With Selection.Interior.Gradient.ColorStops.Add(0)
.Color = 16777164
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(0.45)
.Color = 16777164
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(0.55)
.Color = 10092543
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.Color = 10092543
.TintAndShade = 0
End With
Cancel = True
End If
End If
End Sub

Bonjour Mike31

Bravo,félicitations,tout fonctionne parfaitement bien.

Il me resre à te remercier,très sincèrement,d'avoir consacré tant de temps à mon problème,d'avoir fait preuve de patience,et d'avoir si bien expliqué les chemins à suivre pour la mise en application de tes solutions.
(pour moi, l'utilisation du bouton Activex,est une première.)

Bien sùr,il y a un début à tout,mais,pour des gens,comme moi,heureusement qu'il y a des gens comme toi.

Encore une fois Merci,et,à plus,
(je marque le problème résolu)

micbre