Changement de couleur conditionnel à

Le 19/05/2016 à 20:33

Bonjour Messieurs,

J'ai un fichier avec des formules indirect et j'aimerais que lorsqu'une valeur est affiché en J10 les couleurs des cellules de R10:S10 change. Grace à l'enregistreur de Macro j'ai réussi à avoir la formule suivante;

With Selection.Interior

.Pattern = xlPatternLinearGradient

.Gradient.Degree = 90

.Gradient.ColorStops.Clear

End With

With Selection.Interior.Gradient.ColorStops.Add(0)

.ThemeColor = xlThemeColorLight1

.TintAndShade = 0.349009674367504

End With

With Selection.Interior.Gradient.ColorStops.Add(1)

.ThemeColor = xlThemeColorDark1

.TintAndShade = -0.349009674367504

End With

Range("R10:S10").Select

With Selection.Interior

.Pattern = xlPatternLinearGradient

.Gradient.Degree = 270

.Gradient.ColorStops.Clear

End With

With Selection.Interior.Gradient.ColorStops.Add(0)

.ThemeColor = xlThemeColorDark2

.TintAndShade = 0

End With

With Selection.Interior.Gradient.ColorStops.Add(1)

.ThemeColor = xlThemeColorDark2

.TintAndShade = -0.498031556138798

End With

Toutefois je n'arrive pas à faire en sorte que cela s'applique seulement lorsque ma valeur est vrai, j'ai essayé ceci;

If Range("J10=G120") Then

Pourriez-vous me donner un coup de main?

Merci d'avance et bonne journée

Le 20/05/2016 à 06:06

Bonjour,

Pour que le traitement soit effectué à la condition que J10 et G120 aient la même valeur :

If Range("J10") = Range("G120") Then
    With Range("R10:S10")
        With .Interior
            .Pattern = xlPatternLinearGradient
            .Gradient.Degree = 270
            .Gradient.ColorStops.Clear
        End With
        With .Interior.Gradient.ColorStops.Add(0)
            .ThemeColor = xlThemeColorDark2
            .TintAndShade = 0
        End With
        With .Interior.Gradient.ColorStops.Add(1)
            .ThemeColor = xlThemeColorDark2
            .TintAndShade = -0.498031556138798
        End With
    End With
End If

A+

Le 20/05/2016 à 06:25

Bonsoir Frangy,

en réalité G120 n'est pas une cellule mais bien une valeur en J10. Si je comprends bien la formule que tu m'as fourni?

Merci beaucoup.

Le 20/05/2016 à 07:38

Non, la ligne de code

If Range("J10") = Range("G120") Then

compare les valeurs des cellules J10 et G120.

Si l'égalité est vérifiée, la mise en forme est réalisée.

A+

Le 20/05/2016 à 13:43

J10 est ma cellule et G120 est la valeur à traiter dans cette même cellule.

Merci

Le 20/05/2016 à 15:04

Je ne suis pas sûr de te comprendre

La condition est donc :

If Range("J10").value = "G120" Then

A+

Le 20/05/2016 à 20:13

Bonjour Frangy,

j'ai essayé et cela ne fonctionne malheureusement, je ne suis pas sur d'avoir la bonne entête de Sub...??? J'ai mis le fichier simplifié de mon projet pour aider un peu plus à la recherche de la solution.

Merci de ton aide c'est très apprécié

16forum-changement-de-couleur.xlsm (58.96 Ko)

Le 20/05/2016 à 21:04

Effectivement, je comprends mieux avec le fichier.

Un essai ...

19forum-changement-de-couleur.xlsm (63.52 Ko)

A+

Le 22/05/2016 à 15:48

Bonjour Frangy,

Un énorme Merci pour ton aide cela fonctionne à merveille voici la formule complète et final;

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Target.Address = "$J$10" Then

If Target.Value = "G120" Then

With Range("R10:S10")

With .Interior

.Pattern = xlPatternLinearGradient

.Gradient.Degree = 270

.Gradient.ColorStops.Clear

End With

With .Interior.Gradient.ColorStops.Add(0)

.ThemeColor = xlThemeColorDark2

.TintAndShade = 0

End With

With .Interior.Gradient.ColorStops.Add(1)

.ThemeColor = xlThemeColorDark2

.TintAndShade = -0.498031556138798

End With

End If

If Target.Address = "$J$10" Then

If Target.Value = "G120" Then

With Range("R8:S8")

With .Interior

.Pattern = xlPatternLinearGradient

.Gradient.Degree = 90

.Gradient.ColorStops.Clear

End With

With .Interior.Gradient.ColorStops.Add(0)

.ThemeColor = xlThemeColorLight1

.TintAndShade = 0.349009674367504

End With

With .Interior.Gradient.ColorStops.Add(1)

.ThemeColor = xlThemeColorDark1

.TintAndShade = -0.349009674367504

End With

End If

If Target.Address = "$J$10" Then

If Not Target.Value = "G120" Then

Range("R8:S9").Select

With Selection.Interior

.Pattern = xlNone

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Range("R10:S10").Select

With Selection.Interior

.Pattern = xlNone

.TintAndShade = 0

.PatternTintAndShade = 0

End With

End If

End Sub

Le 22/05/2016 à 22:16

Salut Frangy,

La formule fonctionne merveilleusement bien, maintenant je voulais rajouter une formule dans la séquence;

Range("P10").Select

With Selection.Validation

.Delete

[surligner].Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

xlBetween, Formula1:= _

"=INDIRECT(""_""&C8&""_""&F10&""_""&H10&""_""&J10&""_""&SUBSTITUE(L10;""/"";"""")&""_""&SUBSTITUE(SUBSTITUE(N10;""/"";"""");"" "";""""))"[/surligner]

.IgnoreBlank = True

.InCellDropdown = True

.InputTitle = ""

.ErrorTitle = ""

.InputMessage = ""

.ErrorMessage = ""

.ShowInput = True

.ShowError = True

End With

Lorsque j'enregistre une macro cela fonction, mais lorsque je l'imbrique dans la formule entière que tu m'as fourni il m'affiche le débogueur automatiquement et highlighted

Je suis incapable de zipper le fichier suffisamment pour l'attacher a nouveau au courriel.

Merci beaucoup de ton aide encore Frangy.

Le 23/05/2016 à 05:00

Frangy j'ai réussi en créant de nouveau "Nom" comme ceci;

With Range("P10").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="[color=#FF0000]=Sécurité[/color]"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

Toutefois si tu as une solution de la manière précédente j'apprécierai énormément

Cordialement.

Frangy j'ai réussi en créant de nouveau "Nom" comme ceci;

With Range("P10").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Sécurité"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

Toutefois si tu as une solution de la manière précédente j'apprécierai énormément

Cordialement.

Le 23/05/2016 à 08:33

Bonjour,

Tu peux utiliser le code suivant :

Dim Texte As String
    Texte = "_" & Range("C8") & "_" & Range("F10") & "_" & Range("H10") & "_" & Range("J10") & "_" & Replace(Range("L10"), "/", "") & "_" & Replace(Replace(Range("N10"), "/", ""), " ", "")
    With Range("P10").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & Texte
    End With

Attention toutefois à vérifier la présence du nom dans le gestionnaire de noms.

_Pompe_Discontinu_Simple_G120_1AC240V_16 n'existait pas dans ton exemple

A+

Le 23/05/2016 à 15:23

Bonjour Frangy,

Je viens à l'instant de faire le test et malheureusement cela ne fonctionne pas. Il m'affiche une erreur au niveau du .Add;

Range("P10").Select
        Dim Texte As String
        Texte = "_" & Range("C8") & "_" & Range("F10") & "_" & Range("H10") & "_" & Range("J10") & "_" & Replace(Range("L10"), "/", "") & "_" & Replace(Replace(Range("N10"), "/", ""), " ", "")
        With Range("P10").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & Texte
        End With

Je me suis assurer de faire une sélection pour être certain d'avoir un résultat avec mes "noms" créés

Le 23/05/2016 à 16:07

C'est étrange j'ai réussi à faire fonctionner la formule en enlevant le "e" de Texte dans la phrase Dim Text As String, maintenant j'essaie d'applique cette même formule sur la cellule Q10 et il m'indique une erreur sur cette même phrase, c'est complexe...

' Introduction des formule mathématique dans P10
    Range("P10").Select
        Dim Text As String
        Texte = "_" & Range("C8") & "_" & Range("F10") & "_" & Range("H10") & "_" & Range("J10") & "_" & Replace(Range("L10"), "/", "") & "_" & Replace(Replace(Range("N10"), "/", ""), " ", "")
        With Range("P10").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & Texte
        End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
' Introduction des formule mathématique dans Q10
    Range("Q10").Select
        Dim Texte As String
        Texte = "_" & Range("C8") & "_" & Range("F10") & "_" & Range("H10") & "_" & Range("J10") & "_" & Replace(Range("L10"), "/", "") & "_" & Replace(Replace(Range("N10"), "/", ""), " ", "") & "_" & Range("P10")
        With Range("Q10").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & Texte
        End With

Je n'y comprends plus rien

Le 23/05/2016 à 17:19

J'ai trouvé, la raison était que 2 fois le même nom pour une même String...

Frangy encore un énorme merci de tout ton aide TRÈS TRÈS TRÈS apprécié.

Au plaisir d'avoir besoin de ton aide à nouveau

Rechercher des sujets similaires à "changement couleur conditionnel"