VBA : action en fonction de code couleur

[Amauty]

Bonjour à tous,

Je suis en train de coder une macro qui me permette de venir chercher la valeur d'une cellule d'une plage donnée en fonction de sa couleur pour venir la copier dans une cellule spécifiée en fonction du nom de la feuille d'origine de la cellule de couleur...(pas évident à expliquer).

Voici mon code :


Sub Feuille_resume()
'trouver le rang AV sur chaque segment de marché, en fonction de la couleur
Dim c As Range
Dim c2 As Range

For Each sh In Sheets(Array("ALTO", "AVSV", "AVTS", "ATEMPORAL", "PREMIUM", "CLASSIC", "FML"))
sh.Select
fin = [B65536].End(xlUp).Row
For Each c In Range("b4:b" & fin)
If c.Interior.ColorIndex = -4105 Then Exit For
Next c
For Each c2 In Sheets("resume").Range("c6:i6")
If c2.Text = ActiveSheet.Name Then Exit For
Next c2
Sheets("resume").Cells(c2.Column, c2.Row + 7).Value = c

Next sh
End Sub

le souci que je rencontre pour le moment c'est que le c final (en bleu) ne renvoie aucune valeur. Je ne sais pas comment faire en sorte de mémoriser la valeur de c lorsque l'on sort de la première boucle for.
Ou alors la couleur spécifié n'est pas adéquat. POur trouver la bonne couleur j'ai utilisé la msg box suivante :

Sub color()
MsgBox ActiveCell.Font.ColorIndex
End Sub

en me plaçant sur la cellule avec la couleur souhaitée (est-ce normal que la color index soit négative??)

Merci par avance pour votre précieuse aide

Amaury

 

[fhoest]

Re : VBA : action en fonction de code couleur

Bonjour,
Quelle est la valeur que tu souhaite enregistrer la valeur de cellule c lorsque tu sort

dim mavariable as variant ' car je ne sais pas ce qu'il y a dedans

Sub Feuille_resume()
'trouver le rang AV sur chaque segment de marché, en fonction de la couleur
Dim c As Range
Dim c2 As Range

For Each sh In Sheets(Array("ALTO", "AVSV", "AVTS", "ATEMPORAL", "PREMIUM", "CLASSIC", "FML"))
sh.Select
fin = [B65536].End(xlUp).Row
For Each c In Range("b4:b" & fin)
If c.Interior.ColorIndex = -4105 Then mavariable=c.value:Exit For
Next c
For Each c2 In Sheets("resume").Range("c6:i6")
If c2.Text = ActiveSheet.Name Then Exit For
Next c2
Sheets("resume").Cells(c2.Column, c2.Row + 7).Value = mavariable

Next sh
End Sub

Si c'est ceci que tu cherche.
A+

 

[Amauty]

Re : VBA : action en fonction de code couleur

On oublie la recherche de couleur, quasi impossible dans mon cas car la cellule contenant la couleur en question est une cellule coloré par une MFC (et donc impossible de retrouver la couleur !).
voici mon code final pour contourner ce problème

Sub Feuille_resume()
'trouver le rang AV sur chaque segment de marché, en fonction de la couleur
Dim i As Integer
Dim i2 As Integer
Dim valeur As Variant
Dim c As Range

For Each sh In Sheets(Array("ALTO", "AVSV", "AVTS", "ATEMPORAL", "PREMIUM", "CLASSIC", "FML"))
sh.Select
fin = [B65536].End(xlUp).Row
If fin < 5 Then fin = 4

For i = 4 To fin
If Cells(i, 3).Value Like "*ALTA VISTA*" Then Exit For 'qui revient à reprendre la formule de la MFC
Next i

Cells(i, 2).Select

Set c = selection

For i2 = 3 To 9
If Sheets("resume").Cells(6, i2).Text = ActiveSheet.Name Then Exit For
Next i2
Sheets("resume").Select
Cells(13, i2) = c

Next sh
End Sub

merci pour votre aide

 

[fhoest]

Re : VBA : action en fonction de code couleur

Bonjour,
Rqe: as tu vu que le code de message box n'est pas le même que celui tester dans ton code c'est sans doute pour cela que tu pense que c'est impossible car pour moi il y a toujours une solution (la preuve tu en as trouvé une autre)
A+

 

[Amauty]

Re : VBA : action en fonction de code couleur

Oui j'ai remarqué par la suite mais le problème principal ne vient pas de font. ou de interior. mais bien de la propriété des cellules sous l'action d'une MFC
Et effectivement, il y a toujours une solution, il suffit d'être un peu créatif !