bonjour,

Je souhaite que cette macro me permette de colorer en gris le fond de mes cellules quand "risque acceptable" apparait dans les cellules appelées (i,11).
Il me semble que ma macro est juste mais je dois avoir oublié quelquechose. Si vous voyez de quoi il s'agit ca m'aiderait beaucoup.

Merci d'avance


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
 'calcul résultat
Range("J11").Select
ActiveCell.FormulaR1C1 = "=RC[-5]*RC[-3]*RC[-1]"
Range("J11").Select
Selection.AutoFill Destination:=Range("J11:J1000"), Type:=xlFillDefault
Range("J11:J1000").Select
 
'affichage commentaire
For i = 11 To 1000
Select Case Cells(i, 10)
Case Is = 0
Cells(i, 11) = "-"
Cells(i, 10) = "-"
Case 1 To 249
Cells(i, 11) = "Risque acceptable"
Cells(i, 11).Interior.ColorIndex = 43
Case 250 To 899
Cells(i, 11) = "Actions à mettre en place à plus ou moins long terme"
Cells(i, 11).Interior.ColorIndex = 44
Case Else
Cells(i, 11) = "Risque inacceptable : Plan d'action et planning à respecter"
Cells(i, 11).Interior.ColorIndex = 46
End Select
Next i
 
'quand risque acceptable pas de seconde cotation
Dim ligne1 As Long
Dim ligne2 As Long
Dim ligne3 As Long
Dim ligne4 As Long
 
ligne1 = Application.WorksheetFunction.CountA(Range("K:K")) + 9
ligne2 = Application.WorksheetFunction.CountA(Range("K:K")) + 10
ligne3 = Application.WorksheetFunction.CountA(Range("K:K")) + 11
ligne4 = Application.WorksheetFunction.CountA(Range("K:K")) + 12
 
If Cells(ligne1, 11) = "Risque acceptable" Then
Range(Cells(ligne1, 13), Cells(ligne4, 15)) = 0
Range(Cells(ligne1, 12), Cells(ligne4, 18)).Interior.ColorIndex = 15
End If
If Cells(ligne2, 11) = "Risque acceptable" Then
Range(Cells(ligne1, 13), Cells(ligne4, 15)) = 0
Range(Cells(ligne1, 12), Cells(ligne4, 18)).Interior.ColorIndex = 15
End If
If Cells(ligne3, 11) = "Risque acceptable" Then
Range(Cells(ligne1, 13), Cells(ligne4, 15)) = 0
Range(Cells(ligne1, 12), Cells(ligne4, 18)).Interior.ColorIndex = 15
End If
If Cells(ligne4, 11) = "Risque acceptable" Then
Range(Cells(ligne1, 13), Cells(ligne4, 15)) = 0
Range(Cells(ligne1, 12), Cells(ligne4, 18)).Interior.ColorIndex = 15
End If
End Sub