Mise en forme de cellule en fonction de contenu
Bonjour à tous,
Si quelqu'un aurait une petite idée pour m'aider je tourne un peu en rond..
Je veux créer un badge sur Excel en récupérant des infos d'une base de donnée. Je peux maintenant rentrer un id et les informations charges. Dans une cellule j'ai une liste des zones possible que le visiteur peut voir sous cette forme : "Test 5 / Test 4 / Test 3 / Test 2 / Test" et dans la cellule juste à côté j'ai la couleur de chaque zone sous cette forme : "Yellow / Green / Red / Yellow / Green". Il ne peut y avoir que 3 couleurs : Yellow, green et red. Ce que je voudrais faire c'est avoir sur mon badge 3 cellules : une en fond vert, une jaune et une rouge et les zones dessus par exemple il y aurait ici une cellule verte avec dessus Test 4 / Test etc
Je ne sais pas si c'est clair mais du coup je me suis lancé dans une vba qui ne marche pas :
Sub AfficherZonesParCouleur()
Dim ws As Worksheet
Dim zonesRange As Range
Dim couleursRange As Range
Dim zoneCell As Range
Dim couleurCell As Range
Dim zonesDict As Object
Set zonesDict = CreateObject("Scripting.Dictionary")
' Référence à la feuille de calcul
Set ws = ThisWorkbook.Sheets("Nom_de_la_feuille")
' Référence aux plages de zones et de couleurs
Set zonesRange = ws.Range("H12:H" & ws.Cells(ws.Rows.Count, "H").End(xlUp).Row)
Set couleursRange = ws.Range("I12:I" & ws.Cells(ws.Rows.Count, "I").End(xlUp).Row)
' Parcourir les cellules de zones et de couleurs pour les associer
For Each zoneCell In zonesRange
Set couleurCell = couleursRange.Cells(zoneCell.Row - zonesRange.Cells(1).Row + 1)
If couleurCell.Value <> "" Then
If zonesDict.Exists(couleurCell.Value) Then
zonesDict(couleurCell.Value) = zonesDict(couleurCell.Value) & " / " & zoneCell.Value
Else
zonesDict(couleurCell.Value) = zoneCell.Value
End If
End If
Next zoneCell
' Afficher les zones par couleur dans les cellules K12:K14
ws.Range("K12:K14").ClearContents
ws.Range("L12:L14").ClearFormats
ws.Range("L12:L14").Interior.Color = RGB(255, 255, 255) ' Réinitialiser les couleurs de fond
Dim i As Integer
i = 12
For Each couleur In Array("Green", "Yellow", "Red")
ws.Range("K" & i).Value = couleur
If zonesDict.Exists(couleur) Then
ws.Range("L" & i).Value = zonesDict(couleur)
End If
i = i + 1
Next couleur
End SubEdit modo : code à mettre entre balises avec le bouton </> merci d'y faire attention la prochaine fois
Si quelqu'un à la solution..
Bonjour Thieu et
Je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum et notamment :
- Pour plus de lisibilité, utilisez la fonctionnalité </> pour insérer vos codes VBA (et si possible aussi pour vos formules Excel).
Merci de votre participation et de votre compréhension
Bonjour Thieu,
Une proposition en pièce jointe. Le bouton sur la feuille "Feuil1" exécute la macro.
Cdlt,
Cylfo