Problème pour récupérer un code couleur

Bonjour

Je viens régulièrement consulter ce forum pour trouver des réponses à mes questions d'utilisateur d'EXCEL

mais là j'avoue que je coince

1/ j'ai mis au point une matrice de cartographie des risques qui se remplit dans des cellules de couleur ROUGE, ORANGE ou VERTE en fonction de la gravité et de la fréquence du risque. Je mets dans chaque cellule le n° du risque

Dans ma feuille CARTOGRAPHIE, je voudrai récupérer le code couleur de la cellule dans laquelle j'inscris le n° du risque pour ensuite la réutiliser à l'endroit ou je mets la correspondance entre le n° de risque et le texte du risque lui-même pour faciliter la compréhension

et là je coince ... malgré différentes méthodes utilisées

For i = 7 To .Range("A" & Rows.Count).End(xlUp).Row

'

' Affichage des N° de risques - Colonne B - Ligne 19 & mise en gras

'

Range("B" & i + 12).Value = Nb

Range("B" & i + 12).Font.Bold = True

'

' FREQUENCE : colonne E - GRAVITE : colonne F - Texte du RISQUE UNITAIRE : Colonne D

'

If Cells(4 - .Range("E" & i) + 8, .Range("F" & i) + 4) = "" Then

'

' Affichage du N° du RISQUE UNITAIRE : Colonne A

'

Cells(4 - .Range("E" & i) + 8, .Range("F" & i) + 4) = .Range("A" & i)

CodeCouleur = ActiveCell.Interior.Color

Range("B" & i + 12).Interior.Color = CodeCouleur

Else

Cells(4 - .Range("E" & i) + 8, .Range("F" & i) + 4) = Cells(4 - .Range("E" & i) + 8, .Range("F" & i) + 4) & " - " & .Range("A" & i)

CodeCouleur = ActiveCell.Interior.Color

Range("B" & i + 12).Interior.Color = CodeCouleur

End If

Nb = Nb + 1

Next i

2/ J'ai par ailleurs un second souci lié au fait que ma feuille TABLEAU DES RISQUES comporte des cellules fusionnées

Et évidemment quand EXCEL me décompte le nombre de cellules il y a un nombre plus important que le nombre de risques réels à détecter

For i = 7 To .Range("A" & Rows.Count).End(xlUp).Row

J'utilise la formule ci-dessus mais au lieu de me trouver 13 risques il m'en trouve 41

Merci de votre aide précieuse pour m'aider à trouver les solutions et ainsi progresser

Alain

Bonjour,

ce serait bien que tu mettes ton code entre balises codes (sélectionner le code et pousser sur le bouton "</>").

Voici une proposition

Bravo et merci bcp

c'est exactement ce que je cherchais à faire depuis de nombreux jours

je vais analyser dans le détail ce que vous avez rajouté pour être certain de parfaitement comprendre la logique

en tout cas un grand merci pour l'expertise et la réactivité

Alain

Bonsoir,

voici le code avec quelques commentaires

Private Sub Worksheet_Activate()

    Dim i As Integer, Nb As Integer, CodeCouleur As Variant

    Application.ScreenUpdating = False

    '
    ' Effacement des données de la matrice des risques et mise à fond blanc de la colonne B
    '

    Range("E7:I11").ClearContents
    Range("B19:B60").ClearContents
    Range("B19:B60").Interior.ColorIndex = xlNone
    Selection.Borders.Color = RGB(255, 255, 255)

    '
    ' Détection du nombre maximum de risque d'après la Colonne A de la Feuille TABLEAU DES RISQUES
    '

    With Sheets("Tableau des Risques")

        Nb = 1
        dl = .Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne tableau des risques
        i = 7 'pointeur de lignes sur tableau des risques
        While i <= dl 'on parcourt les lignes de tableau des risques

            '
            ' Affichage des N° de risques - Colonne B - Ligne 19 & mise en gras
            '
            nc = .Range("E" & i).MergeArea.Count 'nombre de cellules fusionnées faisant partie du groupe de la cellule examinée
            Range("B" & Nb + 18).Value = Nb

            Range("B" & Nb + 18).Font.Bold = True

            '
            ' FREQUENCE : colonne E - GRAVITE : colonne F - Texte du RISQUE UNITAIRE : Colonne D
            '

            If Cells(4 - .Range("E" & i) + 8, .Range("F" & i) + 4) = "" Then

                '
                ' Affichage du N° du RISQUE UNITAIRE : Colonne A
                '
                Cells(4 - .Range("E" & i) + 8, .Range("F" & i) + 4) = Cells(4 - .Range("E" & i) + 8, .Range("F" & i) + 4) & " - " & .Range("A" & i) 'on indique le n° du risque dans la cartographie
                CodeCouleur = Cells(4 - .Range("E" & i) + 8, .Range("F" & i) + 4).Interior.Color ''on récupère la couleur correspondant au risque
                Range("B" & Nb + 18).Interior.Color = CodeCouleur
            '
            ' Récupération de la couleur de la cellule dans laquelle le N° de risque est inséré
            '

            Nb = Nb + 1 'incrémentation du nombre de risques

            i = i + nc 'on pointe vers la 1ere ligne du groupe de cellules fusionnées suivant
        Wend

    End With    'Sheets("Tableau des risques")

    '
    ' Adaptation automatique de la hauteur pour les lignes 3 à 7
    '

    Rows("3:7").EntireRow.AutoFit

    '
    ' changement de la hauteur des lignes 3 à 6
    '

    For i = 2 To 7
        If Rows(i).RowHeight < 72 Then Rows(i).RowHeight = 72
    Next i

End Sub