For Dept = 1 To intNbDepartement
Sheets('Carte').Select
ActiveSheet.Shapes(strNameCellGraph).Select
fixerCouleur R, G, B '(sous-routine)
If strNameCellGraph = 'Forme libre 75000' Or strNameCellGraph = 'Forme libre 91000' Or strNameCellGraph = 'Forme libre 92000' Or strNameCellGraph = 'Forme libre 91000' Then
toto = Mid(strNameCellGraph, 13, 2)
strNameCellGraph = 'Forme libre ' & toto
ActiveSheet.Shapes(strNameCellGraph).Select
fixerCouleur R, G, B
End If
Next
Private Sub fixerCouleur(ByVal R As Integer, ByVal G As Integer, ByVal B As Integer)
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(R, G, B)
Selection.ShapeRange.Fill.Visible = msoTrue
End Sub