Sub couleurEncadrement()
Dim c As Range
For Each c In ActiveSheet.UsedRange
If Not c.Borders(xlEdgeLeft).LineStyle = xlNone Then
c.Borders(xlEdgeLeft).Color = 16711680
End If
If Not c.Borders(xlEdgeRight).LineStyle = xlNone Then
c.Borders(xlEdgeRight).Color = 16711680
End If
If Not c.Borders(xlEdgeTop).LineStyle = xlNone Then
c.Borders(xlEdgeTop).Color = 16711680
End If
If Not c.Borders(xlEdgeBottom).LineStyle = xlNone Then
c.Borders(xlEdgeBottom).Color = 16711680
End If
If Not c.Borders(xlInsideVertical).LineStyle = xlNone Then
c.Borders(xlInsideVertical).Color = 16711680
End If
If Not c.Borders(xlInsideHorizontal).LineStyle = xlNone Then
c.Borders(xlEdgeLeft).Color = 16711680
End If
Next c
End Sub
Option Explicit
Sub Quadrillage_couleur()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range("a1:g50")
If c.Borders(xlEdgeLeft).LineStyle <> xlNone Then c.Borders(xlEdgeLeft).ColorIndex = 5
If c.Borders(xlEdgeRight).LineStyle <> xlNone Then c.Borders(xlEdgeRight).ColorIndex = 5
If c.Borders(xlInsideVertical).LineStyle <> xlNone Then c.Borders(xlInsideVertical).ColorIndex = 5
If c.Borders(xlInsideHorizontal).LineStyle <> xlNone Then c.Borders(xlInsideHorizontal).ColorIndex = 5
If c.Borders(xlEdgeTop).LineStyle <> xlNone Then c.Borders(xlEdgeTop).ColorIndex = 5
If c.Borders(xlEdgeBottom).LineStyle <> xlNone Then c.Borders(xlEdgeBottom).ColorIndex = 5
Next
Application.ScreenUpdating = True
End Sub
ActiveWindow.GridlineColor = RGB(0, 0, 255)
Sub couleurEncadrement()
Dim c As Range, couleur1 As Long, couleur2 As Long, position As Long
couleur1 = &HC00000
couleur2 = &HFFFFA0
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
For position = 7 To 12
With c.Borders(position)
If .LineStyle = xlContinuous Then
If .Weight = xlHairline Then
.Color = couleur2
Else
.Color = couleur1
End If
End If
End With
Next position
Next c
End Sub