Coloration de cellules Résolu

Question

Bonjour à tous

J'ai un tableau dans lequel,je colore une cellule sur deux,chaque jour.
Les mêmes cellules,une par jour,recoivent des données et,par double click,recoivent une nouvelle coloration.
Pour être plus explicite,je vous ai mis un lien,çi-dessous,qui vous permettra demieux comprendre mon projet.
Les colorations pour lesquelles je cherche un nouveau procédé,sont,actuellement,obtenues par une macro enregistrée par excel2007,mais n'en suis pas satisfait .
J'ai essayé la MFC,la coloration se fait bien,mais l'effacement ne se fait pas à la commande,et nécessite d'autres manips,que je voudrais eviter.

Si quelqu'un avait une solution,elle serait la bienvenue.
Merci à tous ceux  qui me répondront,et,à +
Micbre


http://www.cijoint.fr/cjlink.php?file=cj201102/cijewwa7Nv.xlsm

Configuration: Windows Vista / Internet Explorer 7.0

melanie1324 · Answer

Bonjour,

Ca va te paraître stupide mais dans la feuille de MFC où tu mets les formats, en as-tu mis un sans coloration?

Mike-31 · Answer

Salut,

Tu peux expliquer exactement ce que tu veux faire. Par contre la coloration en gradient avec une mise en forme conditionnelle sera moins précise

micbre · Answer

Bonjour Mike31,et mélanie1324.

1) Mélanie: Je ne comprends pas le sens de ta question.mais a priori, la réponse est  oui.Tu sais,je ne suis pas  très expérimenté,ceci explique celà.Désolé !

2)Mike:Je désire effectuer le même travail de coloration que celui qui se fait actuellement par la macro commandée par le bouton Q6,et qui ne me plait pas.
Dans cette macro,les  cellules concernées sont coloriées une par une,et j'aurais préféré qu'elles le soient toutes ensemble.
Mes connaissances en VBA sont insuffisantes pour que je puisse réaliser celà moi-même,d'où l'objet de cette discussion.
J'ai abandonné la colorisation par la MFC,car,l'effacement du remplissage,(qui se fait automatiquement lorsque je double clique sur la cellule du jour),ne fonctionne pas avec la couleur installée par MFC.
Est-ce plus clair ?

Merci à vous deux
A +
micbre

melanie1324 · Answer

re,

ce n'est pas encore assez précis.
Mets nous ton fichier à dispo stp sur ci-joint.fr.
Ou pour des raisons de sécurité mets en un bidon mais qui ressemble à ce que tu veux faire.

Quelles cellules doivent se colorier?
Quelles sont les conditions pour qu'elles se colorent?
Quand veux-tu qu'il n'y ait plus de couleurs?

Mike-31 · Answer

Re,

Bon j'ai revue tes macros, en fait ce que tu veux, c'est mettre une cellule sur deux en rouge en un clic et en deux clic toutes passent en gradien jaune/bleu

jusque la pas trés compliqué.
Pourquoi utilises tu en Q6 une cas d'option pour déclencher ta macro que j'ai simplifiée à une dizaine de lignes.

je verrais plutôt un bouton avec une boite de dialogue pour choisir la réinitialisation en cellule rouge ou en gradien afin d'éviter l clic d'erreur

micbre · Answer

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

Mike-31 · Answer

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.

micbre · Answer

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.

Mike-31 · Answer

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

micbre · Answer

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

Mike-31 · Answer

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

Mike-31 · Answer

Re,

J'ai écrit un code sous une autre forme, à tester

https://www.cjoint.com/?0cinVlOBhQW

micbre · Answer

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

Mike-31 · Answer

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

micbre · Answer

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

Mike-31 · Answer

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.

micbre · Answer

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

Mike-31 · Answer

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.

micbre · Answer

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

Mike-31 · Answer

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

micbre · Answer

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 +

Mike-31 · Answer

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

micbre · Answer

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

Mike-31 · Answer

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

micbre · Answer

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

Coloration de cellules - Page 2

Discussions similaires

Newsletters