Coloration de cellules

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

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

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,

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
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,

Si je comprends bien tes tableaux sont sur la même feuille, et présente les mêmes caractéristiques une cellule sur deux et la première commence en BB46 jusqu'à BB106 donc BB46 en couleur, BB 48 etc ... idem pour
BB110:BB170
BB174:BB234
BB240:BB300

re
Bonjour Mike
OK,ça fonctionne comme désiré,grâce à ton pas à pas,difficile de se tromper.
Très sincèrement:MERCI !
Je vais encore te mettre à contribution,si tu acceptes,bien sùr.

Dans mon fichier,j'ai six tableaux du même type,dont quatre sont dans la même colonne,et deux séparés dans deux colonnes différentes:

Colonne BB

BB46:BB106
BB110:BB170
BB174:BB234
BB240:BB300

puis
BX174:BX234

CV174:CV234

Comme la coloration doit se faire chaque mois,en fin de mois,on peut utiliser le même bouton de commande.

Veux tu m'indiquer comment programmer ces plages,dans le code SVP ?

Quelle que soit ta décision,je te renouvelle mes remerciements pour ta patience et ta serviabilité,et j'admire ta compétence.

A +
Micbre

Re,

Donc onglet Développeur, module Contrôle, clic sur le bouton Insérer, dans la partie basse tu verras Contrôle ActiveX, clic sur le premier bouton (Bouton de commande ActiveX) et déssine ton bouton sur la feuille (on verra plus tard pour sa couleur si tu le veux en couleur)

dans la barre des formules tu devrais voir ça
=INCORPORER("Forms.CommandButton.1";"")

reste plus qu'à coller les deux codes dans les propriétés feuille (clic droit sur l'onglet de feuille/visualiser le code)
normalement tu ne devrais pas avoir de problème

Private Sub CommandButton1_Click()
For i = 8 To 70 'de la ligne à la ligne
For j = 17 To 17 'de la colonne à la colonne
If Cells(i, j) <> "" And Cells(i, j).Interior.ColorIndex <> xlNone Then
Cells(i, j).Interior.ColorIndex = 3
End If
If Cells(i, j) = "" Then Cells(i, j).Interior.ColorIndex = xlNone
Next j
Next i
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Selection, Range("Q8:Q70")) 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

dans le ruban module Contrôle, désactive le bouton Mode Création (clic simple)

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Re Mike
j'ai supprimé le bouton
Je suis sur l'onglet développeur,et j'attend tes instructions,si ce n'est pas ce soir,ce sera demain

Re,

le problème vient de ton bouton que tu as fait avec la barre de dessin ou formulaire. je vais te le faire refaire correctement et si tu n'y arrive pas je te retournerais ton fichier.
supprime le bouton en faisant un clic dessus et touche Supp.

Ensuite dis moi si tu as tu Développeur affiché en haut de ton Excel

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

re

J'ai copié le fichier dans un nouvel emplacement.
J'ai vidé totalement la fenêtre VBA.
J'y ai copié les derniers codes reçus de toi.
Résultat: Néant pour le bouton,fonctionnement normal pour le double click
Désolé de t'enquiquiner avec ça.Comme tu me l'as suggéré,je t'envoie le lien pour accéder à cette nouvelle copie.
Merci,et à +
micbre

http://www.cijoint.fr/cjlink.php?file=cj201102/cijC6fmGBN.xlsm

Tu as un problème de téléchargement ou de sécurité

enregistre un de tes fichier sous et colles ces deux codes et teste. à la limite renvoi moi le fichier qui bloque voir si en retour je rencontre le même problème

Re Mike31
Désolé,aucun changement.
J'ai recopié le code ,çi-dessous,tu peux vérifier s'il est conforme.

Je ne sais si c'est une cause de cet échec,mais,à chaque téléchargement,apparait une fenêtre d'erreur,avec un rond rouge dans lequel,il ya un X blanc
Dans la bande bleue en entête,est écrit "explore"
dans le cadre blanc,la phrase:"failed to get data for "Type"
je clique sur OK,et le chargement s"effectue.
Qu'en penses-tu ?

Private Sub CommandButton1_Click()
For i = 8 To 70 'de la ligne à la ligne
For j = 17 To 17 'de la colonne à la colonne
If Cells(i, j) <> "" And Cells(i, j).Interior.ColorIndex <> xlNone Then
Cells(i, j).Interior.ColorIndex = 3
End If
If Cells(i, j) = "" Then Cells(i, j).Interior.ColorIndex = xlNone
Next j
Next i
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Selection, Range("Q8:Q70")) 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

A +
micbre

Re,

J'ai écrit un code sous une autre forme, à tester

https://www.cjoint.com/?0cinVlOBhQW

Re,

Tout à fait, le bouton rouge colorise tes cellules en rouge ensuite double clic sur chaque cellule rouge pour changer de couleur. j'ai beau contrôler et tester le code je ne vois aucun problème
peux tu re renvoyer ce fichier pour voir

Re
Bonjour Mike
J'ai recommencé toute l'opération téléchargement,sans obtenir aucun changement,la première partie du code ne fonctionne toujours pas.
Demande de précision: l'exécution de ce code est bien commandée par clic sur le bouton intitulé "rouge" ?
A +
micbre

Bizarre, je viens de retester le fichier que je t'ai joint sans aucun problème.
Retélécharge le essaye le et tiens moi au courant.
il est possible que sur une action non conforme le code se mette en vrac. si c'est cela j'ajouterai une ligne pour gérer

Re Mike 31

Aucune réaction lorsque je clique sur le bouton.
La deuxième partie du code fonstionne parfaitement.
J'ai visualisé le code,mais je ne sais pas où est le pbm,( compte tenu de la faiblesse de mes connaissances en la matière,ce n'est pas surprenant)

Demain,il fera jour,je te souhaite le bonsoir.
Merci,et, à +

micbre.

Re,

Récupère ton fichier voir si c'est ce que tu cherches

Houuups je n'était trompé de fichier

https://www.cjoint.com/?0chtkLZQjQ

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Re

Mike: d'accord pour mettre une cellule sur deux en rouge en un clic,mais,en deux clics,je mets une seule à la fois en bicolore,pas toutes ensemble.
La commande que j'ai mise n'est pas indispensable,c'est l'idée qui est venue dans ma petite tête,mais je ne suis pas opposé à une autre commande.

Melanie,j'ai mis dans ma demande initiale,un lien "Ci-joint",pour accéder à un extrait de mon fichier,et je viens de vérifier,il fonctionne.
Le voilà:

http://www.cijoint.fr/cjlink.php?file=cj201102/cijewwa7Nv.xlsm

Merci à tous deux
A +
micbre