Couleur de fond définie par une variable

Le 16/12/2023 à 17:47

Liste avec correspondance couleurs RAL

Bonjour,

Je suis totalement novice en Excel et VBA. (et en Forum aussi)

Le sujet a déjà été traité en 2019 sous le même titre mais la solution proposée ne correspond pas exactement à mon besoin, et je suis bien incapable de modifier

même partiellement cette solution.

Mon problème:

J'ai besoin de créer une macro pour une page excel contenant 3 colonnes et 30 lignes :

Colone 1 Référence des pièces

Colonne 2 couleur RAL des pièces (de 1000 à 9023, dont je dispose des correspondances en RVB grâce au sujet précédemment traité)

Colonnes 3 remplissage automatique par la couleur RAL correspondante au RAL de la colonne 2 par la macro dont j'ai besoin.

18ral-rvb.xlsx (16.16 Ko)

L' un d'entre vous pourrait il proposé à un béotien une solution, la plus simple possible svp?

Je joint le fichier des correspondances, dont je remercie l'auteur au passage (incluant une formule recherchev)

D'avance merci pour vos idées ou solutions

Le 16/12/2023 à 18:05

Bonsoir JudgeMax, le forum,

Un essai....

Sub test()
 Dim dl%, lig%
 Dim R, G, B
  Application.ScreenUpdating = False '...................désactive le rafraichissement de l'écran
   With Sheets("Feuil1") '...............................agit sur cette feuille uniquement
    dl = .Range("B" & Rows.Count).End(xlUp).Row '........dernière ligne remplie de la colonne B
     For lig = 1 To dl '.................................boucle de la première à la dernière ligne
      R = Split(.Range("C" & lig), ",")(0) '.............récupère les  chiffres avant la première virgule
      G = Split(.Range("C" & lig), ",")(1) '.............récupère les chiffres entre les 2 virgules
      B = Split(.Range("C" & lig), ",")(2) '.............récupère les chiffres après la seconde virgule
      .Range("C" & lig).Interior.Color = RGB(R, G, B) '..applique la couleur RGB en fonction de ces chiffres
     Next lig '..........................................ligne suivante
   End With
End Sub
10judgemax.xlsm (23.68 Ko)

On peut également masquer les écritures en colonne c...en modifiant la couleur de la police...

.Range("C" & lig).Font.Color = RGB(R, G, B) '......applique la couleur à la police également (facultatif)
10judgemax2.xlsm (22.90 Ko)

Cordialement,

Le 16/12/2023 à 18:36

Bonjour xorsankukai,

Et surtout merci d'avoir pris la peine pour la réactivité :)

Les solutions que vous proposez sont intéressantes pour la suite (concernant la couleur des polices mais pas que).

Malheureusement je me suis mal expliqué et n'ai qu'un transmis qu'un fichier partiel: méa culpa :(

je joins le fichier modèle avec 2 feuilles, peut être que cela sera plus clair

Encore merci pour le coup de main

10ral-rvb-2.xlsx (19.66 Ko)

Cordialement

Le 16/12/2023 à 19:49

Re,

Nouvel essai...

  • J'ai mis tes données sous forme de tableaux structurés (si tu rajoutes des données, les plages s'adaptent automatiquement, pas besoin de modifier le code).
  • J'ai rajouté une formule rechercheV dans la colonne "COULEUR EQUIVALENCE RAL", une macro évènementielle qui se déclenche à chaque changement dans la colonne "Numéro RAL".
12ral-rvb-v3.xlsm (30.53 Ko)

Cordialement,

Le 18/12/2023 à 07:28

Bonjour,

Et encore merci, surtout pour les réponse rapides, le temps passé à faire ça, et la compréhension

de ma demande pas très claire (limite lecture de le pensée ou télépathie).

C'est super top de chez top!

Je n'ai pas eu le temps de m'en occuper ce dimanche, mais je regarde ça aujourd'hui.

Bonne journée :)

Cordialement

Le 18/12/2023 à 17:51

Bonsoir,

Re,

J'espère ne pas abuser, si c'est le cas je comprendrais

Tant que je n'insère pas de nouvelle tout est ok, mais si j'en insère, ça ne fonctionne plus ...ou ça indique les chiffre en RVB, texte coloré ou pas.

Une idée svp?

Merci

Cordialement

13ral-rvb-v3-2.xlsm (30.81 Ko)
Le 19/12/2023 à 09:37

Bonjour JudgeMax, le forum,

Effectivement, si tu rajoutes des colonnes avant NUMERO RAL, cela ne fonctionne plus puisque j'indiquais la colonne 2 dans le code...

If Not Application.Intersect(Target, Me.ListObjects(1).ListColumns(2).DataBodyRange) Is Nothing Then

Essaies ainsi en utilisant l'intitulé de la colonne:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim R, G, B
  'si changement dans colonne 2 du tableau
  If Not Application.Intersect(Target, Me.ListObjects(1).ListColumns("NUMERO RAL").DataBodyRange) Is Nothing Then
   cancel = True
    If Target.Count > 1 Then Exit Sub '.........si une seule cellule
     With Target.Offset(0, 1) '.................agit sur la cellule à droite de la cible
      If .Value <> "" Then '....................si non vide
       R = Split(.Value, ",")(0)  '.............récupère les  chiffres avant la première virgule
       G = Split(.Value, ",")(1)  '.............récupère les chiffres entre les 2 virgules
       B = Split(.Value, ",")(2)  '.............récupère les chiffres après la seconde virgule
       .Interior.Color = RGB(R, G, B) '.........applique la couleur RGB en fonction de ces chiffres
       .Font.Color = RGB(R, G, B) '.............applique la couleur à la police également (facultatif)
      Else
       .Interior.Color = xlNone '...............aucun remplissage
      End If
     End With
  End If
End Sub

Cordialement,

Le 19/12/2023 à 10:26

Re,

Au cas où les colonnes "COULEUR RAL" et "COULEUR EQUIVALENCE RAL" ne soient pas côte à côte....

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim R, G, B, lig%
  'si changement dans colonne "NUMERO RAL" du tableau
  If Not Application.Intersect(Target, Me.ListObjects(1).ListColumns("NUMERO RAL").DataBodyRange) Is Nothing Then
   cancel = True
    If Target.Count > 1 Then Exit Sub '.........si une seule cellule
     lig = Target.Row - Me.ListObjects(1).Range.Row 'définit la ligne de la cellule cible
     'agit sur la cellule de la colonne "COULEUR EQUIVALENCE RAL" correspondant à la ligne
     With Me.ListObjects(1).DataBodyRange(lig, Me.ListObjects(1).ListColumns("COULEUR EQUIVALENCE RAL").Index)
      If .Value <> "" Then '....................si non vide
       R = Split(.Value, ",")(0)  '.............récupère les  chiffres avant la première virgule
       G = Split(.Value, ",")(1)  '.............récupère les chiffres entre les 2 virgules
       B = Split(.Value, ",")(2)  '.............récupère les chiffres après la seconde virgule
       .Interior.Color = RGB(R, G, B) '.........applique la couleur RGB en fonction de ces chiffres
       .Font.Color = RGB(R, G, B) '.............applique la couleur à la police également (facultatif)
      Else
       .Interior.Color = xlNone '...............aucun remplissage
      End If
     End With
  End If
End Sub

Cordialement,

Le 19/12/2023 à 18:34

Bonjour,

Là tout est fait, c'est parfait pour l'utilisation que je veux en faire (c'est même mieux que mon idée de départ).

Toute ma reconnaissance et surtout passe de très bonnes fêtes de fin d'année.

Encore merci

Bien cordialement

Max

Le 19/12/2023 à 18:59

Re,

Merci pour le retour et ravi que ton problème soit solutionné,

Pense à clôturer le sujet :

Passe de bonnes fêtes également,

Bonne continuation,

Rechercher des sujets similaires à "couleur fond definie variable"