Coloration de cellules
Résolu
micbre
Messages postés
16
Date d'inscription
Statut
Membre
Dernière intervention
-
micbre Messages postés 16 Date d'inscription Statut Membre Dernière intervention -
micbre Messages postés 16 Date d'inscription Statut Membre Dernière intervention -
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
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
A voir également:
- Coloration de cellules
- Formule excel pour additionner plusieurs cellules - Guide
- Verrouiller cellules excel - Guide
- Concatener deux cellules excel - Guide
- Colorer des cellules excel sous condition - Guide
- Vba excel sélectionner une plage de cellules variable ✓ - Forum VB / VBA
25 réponses
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 +
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
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
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
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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
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