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 54 55
| Sub RecupFondCouleur()
Dim F1 As Worksheet, F2 As Worksheet
Dim Col%, Lg%, DerLig_f1%
Application.ScreenUpdating = False
Set F1 = Sheets("Feuil1")
Set F2 = Sheets("Feuil2")
DerLig_f1 = F1.Range("A" & Rows.Count).End(xlUp).Row
For Col = 1 To 3
For Lg = 2 To DerLig_f1
If F1.Cells(Lg, Col) <= 0.2 Then
F2.Cells(Lg, Col).Interior.Color = RGB(75, 255, 75) 'fond Vert foncè
F2.Cells(Lg, Col).Font.Color = RGB(0, 0, 0) 'police noir
ElseIf F1.Cells(Lg, Col) <= 0.5 Then
With F2.Cells(Lg, Col).Interior
.Pattern = xlGray50
.PatternThemeColor = xlThemeColorDark1
.Color = RGB(0, 255, 0) 'fond Vert grisé
End With
F2.Cells(Lg, Col).Font.Color = RGB(0, 0, 0) 'police noir
ElseIf F1.Cells(Lg, Col) <= 1 Then
F2.Cells(Lg, Col).Interior.Color = RGB(255, 255, 105) 'fond Jaune pâle
F2.Cells(Lg, Col).Font.Color = RGB(0, 0, 0) 'police noir
ElseIf F1.Cells(Lg, Col) <= 3 Then
F2.Cells(Lg, Col).Interior.Color = RGB(255, 214, 139) 'fond orange pâle
F2.Cells(Lg, Col).Font.Color = RGB(0, 0, 0) 'police noir
ElseIf F1.Cells(Lg, Col) <= 5 Then
F2.Cells(Lg, Col).Interior.Color = RGB(255, 0, 0) 'fond rouge
F2.Cells(Lg, Col).Font.Color = RGB(0, 0, 0) 'police noir
ElseIf F1.Cells(Lg, Col) <= 10 Then
With F2.Cells(Lg, Col).Interior
.Pattern = xlGray50
.PatternThemeColor = xlThemeColorLight1
.Color = RGB(255, 0, 0) ' fond rouge grisé
End With
F2.Cells(Lg, Col).Font.Color = RGB(255, 214, 139) 'police orange pâle
ElseIf F1.Cells(Lg, Col) <= 15 Then
With F2.Cells(Lg, Col).Interior
.Pattern = xlGray50
.PatternThemeColor = xlThemeColorLight1
.Color = RGB(153, 51, 102) 'fond rouge bordeaux grisé
End With
F2.Cells(Lg, Col).Font.Color = RGB(255, 255, 105) 'police Jaune pâle
ElseIf F1.Cells(Lg, Col) > 50 Then
F2.Cells(Lg, Col).Interior.Color = RGB(0, 0, 0) 'fond noir
F2.Cells(Lg, Col).Font.Color = RGB(255, 214, 139) 'police orange pâle
Else
F2.Cells(Lg, Col).Interior.Color = RGB(0, 0, 0) 'fond noir
F2.Cells(Lg, Col).Font.Color = RGB(255, 214, 139) 'police orange pâle
End If
Next Lg
Next Col
Set F1 = Nothing
Set F2 = Nothing
End Sub |
Partager