Microsoft 365 Copie de couleur d'une cellule à une autre

[treza88]

Bonjour à tous,

J'essaie sans succès de copier une couleur de cellule et de la copier dans une cellule cible.

Mon code, parmi d'autres est le suivant et ne fonctionne pas, et je ne trouve pas de solution :

Sub test()

Dim col As Long

col = Cells(val.Row, val.Column).Interior.Color
MsgBox (col)

Range(Target.Address).Interior.Color = col

End Sub

 

[dysorthographie]

bonsoir,
ou as tu défini les variables val et Target?

val est un mos réservé je t'invites à ne pas utiliser ce genre de nomination!

 

[TooFatBoy]

Bonjour,

Où sont définis Val et Target ?

Pourquoi Cells(val.Row, val.Column).Interior.Color et non directement
val.Interior.Color ?

 

[Staple1600]

Bonjour le fil

Histoire d'être dans VBE plutôt que dans mon lit

Sub mTest()
Dim col&
col = Couleur_Cellule([B3])
Range("C5").Interior.Color = col
End Sub
Private Function Couleur_Cellule(ByRef r As Range) As Long
Couleur_Cellule = r.Interior.Color
End Function

 

[treza88]

Toutes mes excuses à vous trois, mais je devais être très fatigué hier soir, et en plus la nuit porte conseil.

En fin de compte c'est plutôt ça que je voulais proposer comme code, qui est un peu plus sérieux que le précédent.

C'est une fonction qui récupère la couleur de fond d'une autre cellule :

Function Lookup_Example2(ByVal Target As Range)
    Application.Volatile
    Dim val As Range
    Dim col As Variant
    Set val = Worksheets("Charge").Range("D7:D222").Find(1015, , xlValues, xlWhole, , , False)
    col = Cells(val.Row, val.Column).Interior.Color
    'MsgBox (col)
    Range(Target.Address).Interior.Color = col
    'MsgBox (Target.Address)
End Function

je récupère bien le code couleur correspondant à la valeur recherchée, mais je n'arrive pas à l'appliquer dans une cellule à coté de celle qui contient la formule.

Est ce que cela ne vient pas de "ByVal Target As Range" ?

 

[Staple1600]

Bonsoir le fil

@treza88
Tu n'as pas testé le code que je proposais dans le message#4 ?
Dans cet exemple, la cellule C5 récupère bien la couleur de la cellule B3.

 

[TooFatBoy]

Tu n'as pas testé le code que je proposais dans le message#4 ?

Pas sûr qu'il lise les messages qu'on poste...
Perso, je n'ai aucune réponse à ma question et il y a toujours Cells(val.Row, val.Column).Interior.Color.

De plus la "question" n'est pas très claire car au début on avait une macro et maintenant on a une fonction.


Tout ça c'est trop compliqué pour mon dernier neurone et je ne veux pas le faire fondre, alors je m'éclipse.
Bonne chance pour la suite.

 

[treza88]

Pas sûr qu'il lise les messages qu'on poste...

Si bien sur que je lit les messages que vous avez posté et je vous en remercie et m'excuse de ne pas être intervenu plutôt, mais je les lit.
Je pensais juste que vous alliez laisser tomber le code de départ et reprendre le code du post#5.

au début on avait une macro et maintenant on a une fonction

Oui c'est ce que j'ai expliqué au post#5, mon premier code est incomplet et ne correspond pas a mon besoin, ce que j'ai besoin c'est d'une fonction (j'aurais du marquer fonction personnalisé, ça aurait été peut être plus clair) que je puisse recopier dans un tableau.

je n'ai aucune réponse à ma question

Si en parti au post#5, dans le code, il y a :

Function Lookup_Example2(ByVal Target As Range)

et

Dim val As Range

Quand à "val.Interior.Color?" je suis passé a coté, et c'est vrai que j'aurai du l'écrire comme ça, plutôt que de me compliquer la vie.

Tu n'as pas testé le code que je proposais dans le message#4 ?

Non je ne l'ai pas testé, car il ne correspond pas à mon besoin au post#5, car je passe par une recherche de valeur dans un tableau pour déterminer la couleur et je veux mettre la couleur dans une cellule défini par le "Target" de la fonction, pour pouvoir recopier vers le bas la fonction dans un autre tableau.

Je sais que là avec mes explications ce n'est pas forcément facile a suivre.

Mais le bon raisonnement consiste dans le code du post#5.

 

[mapomme]

Bonjour à tous,

Pourquoi diable utiliser une fonction puisqu’une aucune valeur n'est renvoyée ? Utilisez une procédure.

Sub Lookup_Example2(ByVal Cible As Range)
Dim RechLigne As Long
   RechLigne = Application.IfError(Application.Match(1015, Worksheets("Charge").Range("D7:D222"), 0), 0)
   If RechLigne Then
      Cible.Interior.Color = Worksheets("Charge").Cells(RechLigne + 7 - 1, 4).Interior.Color
   Else
      Cible.Interior.ColorIndex = xlColorIndexNone
   End If
End Sub

 

[treza88]

Merci mapomme pour ton retour,

oui je comprend bien , mais je partais sur une fonction car je voulais m'en servir comme fonction personnalisée dans une feuille de calcul.
Cependant ta question me fait penser à autre chose dont je ne maitrise pas le sujet.

Peut on dans une fonction personnalisée faire appel à cette procédure pour avoir la même fonctionnalité que la fonction personnalisée que j'avais mis au début de la discussion ?

C'est à dire à dire un peu tromper Excel pour lui faire croire que la procédure est une fonction ?

Car si je ne me trompe pas on ne peut pas appeler de procédure directement dans une cellule.

 

[Dranreb]

Bonsoir.
On ne peut pas changer la couleur de fond d'une cellule pendant l'évaluation d'une formule, un point c'est tout. Le faire faire par une autre procédure pendant n'y change rien. Le faire faire par une autre procédure après, si … Notamment par une Private Sub Workbook_SheetCalculate du module ThisWorkbook par exemple, ça marche. Mais à condition que la fonction en ait enregistré la demande quelque part, dans une Collection VBA par exemple. Et pour ça il faut qu'elle ait été évaluée. Cela implique qu'au moins un des antécédents qui lui ont été dûment transmis en paramètres ait changé de valeur.

 

[Dranreb]

Par exemple dans un module standard :

Option Explicit
Private ClnCsg As Collection
Function ValCF(ByVal Cel As Range)
Rem. Valeur et Couleur de Fond
   If ClnCsg Is Nothing Then Set ClnCsg = New Collection
   ClnCsg.Add Array(Application.Caller, Cel.Interior.Color)
   ValCF = Cel.Value
   End Function
Public Sub ExécuterConsignes()
Rem. Exécute les consignes.
'    Invoquée par la Sub Workbook_SheetCalculate de ThisWorkbook
   Dim TRngIC()
   If ClnCsg Is Nothing Then Exit Sub
   Do While ClnCsg.Count > 0
      TRngIC = ClnCsg(1): ClnCsg.Remove 1
      TRngIC(0).Interior.Color = TRngIC(1)
      Loop
   End Sub

Dans ThisWorkbook :

Option Explicit
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
   ExécuterConsignes
   End Sub