Couleurs dans cellules

[bernardrustrel]

Bonjour à tous.
Dans le fichier joint j'aimerais pouvoir colorier les plages D2:E2 et J2:K2 en Jaune et la plage G2:H2 en bleu.
Ces couleurs sont respectivement représentées en N1 et O1.
j'ai essayé une solution avec "Worksheet_SelectionChange(ByVal Target As Range)" mais voilà cette dernière agit sur les valeurs situées en N2 et O2 qui sont issues de la fonction SOMMESICOULEUR et que je ne dois pas modifier.
Pour moi le nec plus ultra serait:
- sélectionner la plage à colorier
- sélectionner la couleur à appliquer ( il m'est possible de mettre un caractère tel le J ou B) si cela peut simplifier l'application de la couleur),
J'explique: si dans les différentes plages j'y écris un J (par exemple) alors les cellules concernées prennent la couleur Jaune mais le J doit disparaître car je dois ensuite saisir une valeur numérique dans ces cellules.
Par avance je vous remercie devotre aide.
Cordialment. Bernard

 

[DoubleZero]

Re : Couleurs dans cellules

Bonjour, bernardrustrel, le Forum,

En attendant mieux... un essai en pièce jointe.

Codes dans le Module2 et dans le module de l'onglet "Feuil1".

A bientôt 🙂

P. S. : Grand bonjour + gros zibous, Papou 😀

 

[Paritec]

Re : Couleurs dans cellules

Bonjour Bernardrustrel le forum
ton fichier en retour
a+
Papou😱


EDIT Bonjour G 00 bisous Papou😱

 

[job75]

Re : Couleurs dans cellules

Bonjour bernardrustrel,

Voyez le fichier joint et cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim jaune&, bleu&, r As Range, x$
jaune = [N1].Interior.Color 'cellule à adapter
bleu = [O1].Interior.Color
Set r = Intersect(Target, Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In r
  x = Mid(r, 3)
  If LCase(Left(r, 2)) = "jj" Then
    r.Interior.Color = jaune
    If IsNumeric(x) Then r = CDbl(x) Else r = x
  ElseIf LCase(Left(r, 2)) = "bb" Then
    r.Interior.Color = bleu
    If IsNumeric(x) Then r = CDbl(x) Else r = x
  Else
    r.Interior.ColorIndex = xlNone 'RAZ
    x = r.Formula: r = Chr(1): r = x 'recalcul des fonctions volatiles
  End If
Next
Application.EnableEvents = True
End Sub

Par ailleurs j'ai rendu volatile la fonction SOMMESICOULEUR.

A+

 

[bernardrustrel]

Re : Couleurs dans cellules

Bonjour et merci pour cette réponse.

 

[bernardrustrel]

Re : Couleurs dans cellules

Bonjour Paritec
Merci pour cette solution, elle convient parfaitement il me reste plus qu'à l'adapter à mes besoins,
Bernardrustrel

 

[bernardrustrel]

Re : Couleurs dans cellules

Bonjour Double zero
Reponse rapide et parfaite, je l'adapterai à mes besoins car les boutons doivnet disparaitre.

Merci encore.
Cordialement
Bernardrustrel

 

[job75]

Re : Couleurs dans cellules

Re,

J'avais zappé 00 et Papou, bonjour à vous deux 🙂

A+

 

[Paritec]

Re : Couleurs dans cellules

Bonjour Job😱 le forum
pas de souci a +
Papou😱

 

[job75]

Re : Couleurs dans cellules

Re,

Une solution avec touches de raccourci pour lancer ces macros :

Sub Jaune()
'touches Ctrl+J
If Intersect(Selection, [N1:O1]) Is Nothing Then
  Selection.Interior.Color = [N1].Interior.Color
  [A1] = [A1].Formula 'recalcul de la fonction volatile
End If
End Sub

Sub Bleu()
'touches Ctrl+B
If Intersect(Selection, [N1:O1]) Is Nothing Then
  Selection.Interior.Color = [O1].Interior.Color
  [A1] = [A1].Formula 'recalcul de la fonction volatile
End If
End Sub

Sub Efface()
'touches Ctrl+E
If Intersect(Selection, [N1:O1]) Is Nothing Then
  Selection.Interior.ColorIndex = xlNone
  [A1] = [A1].Formula 'recalcul de la fonction volatile
End If
End Sub

Important : la fonction SOMMESICOULEUR a été rendue volatile.

Fichier (2).

A+

 

[job75]

Re : Couleurs dans cellules

Re,

Au post #1 vous dites qu'il ne faut pas modifier les valeurs en N2 et O2.

Cela ne me paraît pas cohérent, mais dans ce cas retirez Application.Volatile dans SOMMESICOULEUR.

A+

 

[Staple1600]

Re : Couleurs dans cellules

Bonjour à tous

Job75
Pour le plaisir de te croiser et pour le fun
Une trois en un (sans fromage) 😉

Sub Coloriage(Choix As Byte)
Dim Couleurs
Couleurs = Array(6, 33, xlNone)
If Intersect(Selection, [N1:O1]) Is Nothing Then
  Selection.Interior.ColorIndex = Couleurs(Choix)
  [A1] = [A1].Formula 'recalcul de la fonction volatile
End If
End Sub

Sub Jaune()
Coloriage 0
End Sub

Sub Bleu()
Coloriage 1
End Sub

Sub Efface()
Coloriage 2
End Sub