recuperation couleur cellule puis la donner autre cellule

[Ani60]

bonjour,
j'essaie de mettre dans une cellule A2 la couleur suivant la valeur de cette cellule (couleurs se trouvant feuille code). j'arrive à trouver la valeur et l'adresse de la cellule mais je recuperer toujours la meme valeur -4142, pour pouvoir l'affecter à la cellule A2.
une petit aide serai la bienvenue
merci
Ani60
ps. faut cliquer sur le bouton

 

[Guest]

Bonjour,

Dans ta macro, rien qu'une petite chose à changer pour qu'elle fonctionne:
Range(CelTrou.Address)-> CelTrou

Sub Color()
Dim CelTrou As Range, CodeCh As String
Dim Coul As Variant, adr As Range
CodeCh = Sheets("Feuille").Range("A2").Value
With Sheets("Code").Range("A:A")
Set CelTrou = .Find(CodeCh, , xlValues, xlWhole, xlByRows)
End With
Coul = CelTrou.Interior.ColorIndex
Sheets("Feuille").Range("A2").Interior.ColorIndex = Coul
MsgBox CelTrou
MsgBox Coul
End Sub

Si tu fais Range(CelTrou.address) en restant sur la Feuille "Feuille", c'est une cellule de cette feuille qui est retournée. Cellule dont l'adresse est la même que celle de CelTrou sur l'autre feuille. Clair?

A+

 

[david84]

Re : recuperation couleur cellule puis la donner autre cellule

Bonjour,
Regarde la réponse que BrunoM45 a faite sur ce fil ici, ce peut peut-être répondre à ta demande.
A+
Edit : salut Hasco, je vais regarder ta proposition (comme souvent) !

 

[laetitia90]

Re : recuperation couleur cellule puis la donner autre cellule

bonjour Ani60 , Hasco, david84

Dim a As Range
Set a = Sheets("Code").Range("A:A").Find(What:=[A2], LookIn:=xlValues, LookAt:=xlWhole)
If Not a Is Nothing Then [A2].Interior.ColorIndex = a.Interior.ColorIndex

 

[Ani60]

Re : Re: recuperation couleur cellule puis la donner autre cellule

Bonjour,

Dans ta macro, rien qu'une petite chose à changer pour qu'elle fonctionne:
Range(CelTrou.Address)-> CelTrou

Sub Color()
Dim CelTrou As Range, CodeCh As String
Dim Coul As Variant, adr As Range
CodeCh = Sheets("Feuille").Range("A2").Value
With Sheets("Code").Range("A:A")
Set CelTrou = .Find(CodeCh, , xlValues, xlWhole, xlByRows)
End With
Coul = CelTrou.Interior.ColorIndex
Sheets("Feuille").Range("A2").Interior.ColorIndex = Coul
MsgBox CelTrou
MsgBox Coul
End Sub

Si tu fais Range(CelTrou.address) en restant sur la Feuille "Feuille", c'est une cellule de cette feuille qui est retournée. Cellule dont l'adresse est la même que celle de CelTrou sur l'autre feuille. Clair?

A+

Bonjour,
Merci pour ton aide et tes explications, j'ai tout compris

bye
Ani60

 

[Ani60]

Re : recuperation couleur cellule puis la donner autre cellule

bonjour Ani60 , Hasco, david84

Dim a As Range
Set a = Sheets("Code").Range("A:A").Find(What:=[A2], LookIn:=xlValues, LookAt:=xlWhole)
If Not a Is Nothing Then [A2].Interior.ColorIndex = a.Interior.ColorIndex

Merci pour ta réponse, j'ai pris la solution de Hasco
merci quand même pour ton aide
bye
Ani60

 

[Ani60]

Re : recuperation couleur cellule puis la donner autre cellule

Re-à tous,
Je reviens vers vous pour un détail qui a son importance
comment renvoyer une couleur de fond normal -4142 quand on ne trouve pas le texte de la cellule

merci beaucoup
bye
ANi60

 

[david84]

Re : recuperation couleur cellule puis la donner autre cellule

Re
A tester (en utilisant Match mais les autres codes sont également adaptables) :

Sub test()
Dim Plage, CodeCh$, Resultat&, Coul
CodeCh = Sheets("Feuille").[A2].Value
Set Plage = Sheets("Code").[A:A]
On Error Resume Next
Resultat = Application.Match(CodeCh, Plage, 0)
If IsError(Resultat) = True Then GoTo Erreur
Coul = Sheets("Code").Cells(Resultat, 1).Interior.ColorIndex
Sheets("Feuille").[A2].Interior.ColorIndex = Coul
Exit Sub
Erreur:
Sheets("Feuille").[A2].Interior.ColorIndex = xlNone
End Sub

A+

 

[david84]

Re : recuperation couleur cellule puis la donner autre cellule

Re re
Plutôt comme cela si tu veux conserver les boîtes de dialogue :

Sub test2()
Dim Plage, CodeCh$, Resultat&, Coul, Msg$
CodeCh = Sheets("Feuille").[A2].Value
Set Plage = Sheets("Code").[A:A]
On Error Resume Next
Resultat = Application.Match(CodeCh, Plage, 0)
    If Resultat = 0 Then
        Sheets("Feuille").[A2].Interior.ColorIndex = xlNone
        MsgBox "Code non répertorié"
    Else
        Coul = Sheets("Code").Cells(Resultat, 1).Interior.ColorIndex
        Sheets("Feuille").[A2].Interior.ColorIndex = Coul
        MsgBox Sheets("Code").Cells(Resultat, 1).Value
        MsgBox Sheets("Code").Cells(Resultat, 1).Interior.ColorIndex
    End If
Exit Sub

End Sub

A+

 

[Ani60]

Re : recuperation couleur cellule puis la donner autre cellule

Re re
Plutôt comme cela si tu veux conserver les boîtes de dialogue :

Sub test2()
Dim Plage, CodeCh$, Resultat&, Coul, Msg$
CodeCh = Sheets("Feuille").[A2].Value
Set Plage = Sheets("Code").[A:A]
On Error Resume Next
Resultat = Application.Match(CodeCh, Plage, 0)
    If Resultat = 0 Then
        Sheets("Feuille").[A2].Interior.ColorIndex = xlNone
        MsgBox "Code non répertorié"
    Else
        Coul = Sheets("Code").Cells(Resultat, 1).Interior.ColorIndex
        Sheets("Feuille").[A2].Interior.ColorIndex = Coul
        MsgBox Sheets("Code").Cells(Resultat, 1).Value
        MsgBox Sheets("Code").Cells(Resultat, 1).Interior.ColorIndex
    End If
Exit Sub

End Sub

A+

Bonsoir,
merci pour ton aide, cela fonctionne parfaitement
une question: pourquoi dans la ligne avec dim, il ya pas as range ou autre
bye
Ani60

 

[david84]

Re : recuperation couleur cellule puis la donner autre cellule

Re

une question: pourquoi dans la ligne avec dim, il ya pas as range ou autre

J'utilise l'instruction Set pour attribuer une référence d'objet à la Plage, donc je ne déclare pas la variable Plage en tant que Range.
Comme je ne précise rien derrière Dim Plage, Plage est implicitement déclaré en Variant.
Ceci-dit, des VBAistes confirmés pourront certainement te l'expliquer mieux que moi, voir pondérer ou infirmer ce que je te dis.
A+

 

[Ani60]

Re : recuperation couleur cellule puis la donner autre cellule

Re-bonsoir
merci pour tes explcations, je dormirais un peu moins bete ce soir lol
bye
Ani60