VBA---Quadrillage diagonal.

Sub Diagonales()
Dim plage As Range, c1 As Range, c2 As Range, i&
Set plage = [H2:Y18]
plage.Borders(xlDiagonalUp).LineStyle = xlNone 'RAZ
plage.Borders(xlDiagonalDown).LineStyle = xlNone
For Each c1 In plage
  If c1 = "X" Then
    For Each c2 In plage
      If c2 = "X" And c2.Address <> c1.Address Then
        If c2.Row - c1.Row = c2.Column - c1.Column Then
          For i = 0 To c2.Row - c1.Row Step Sgn(c2.Row - c1.Row)
            c1.Offset(i, i).Borders(xlDiagonalDown).Weight = xlThin
          Next
        ElseIf c2.Row - c1.Row = c1.Column - c2.Column Then
          For i = 0 To c2.Row - c1.Row Step Sgn(c2.Row - c1.Row)
            c1.Offset(i, -i).Borders(xlDiagonalUp).Weight = xlThin
          Next
        End If
      End If
    Next
  End If
Next
End Sub

Sub Diagonales()
Dim plage As Range, c1 As Range, flag As Boolean, c2 As Range, i&
Set plage = [H2:Y18]
plage.Borders(xlDiagonalUp).LineStyle = xlNone 'RAZ
plage.Borders(xlDiagonalDown).LineStyle = xlNone
plage.Font.ColorIndex = 3 'rouge
For Each c1 In plage
  If c1 = "X" Then
    flag = False
    For Each c2 In plage
      If c2 = "X" And c2.Address <> c1.Address Then
        If c2.Row - c1.Row = c2.Column - c1.Column Then
          flag = True
          For i = 0 To c2.Row - c1.Row Step Sgn(c2.Row - c1.Row)
            c1.Offset(i, i).Borders(xlDiagonalDown).Weight = xlThin
            If i > 0 Then c1.Offset(i, i).Font.ColorIndex = xlAutomatic
          Next
        ElseIf c2.Row - c1.Row = c1.Column - c2.Column Then
          flag = True
          For i = 0 To c2.Row - c1.Row Step Sgn(c2.Row - c1.Row)
            c1.Offset(i, -i).Borders(xlDiagonalUp).Weight = xlThin
            If i > 0 Then c1.Offset(i, -i).Font.ColorIndex = xlAutomatic
          Next
        End If
      End If
    Next
    If Not flag Then c1.Font.ColorIndex = xlAutomatic
  End If
Next
End Sub

Sub Diagonales()
Dim plage As Range
Set plage = [H2:Y18]
plage.Borders(xlDiagonalUp).LineStyle = xlNone 'RAZ
plage.Borders(xlDiagonalDown).LineStyle = xlNone
plage.Font.ColorIndex = xlAutomatic
Analyse plage, Union(plage.Columns(1), plage.Rows(1)), 1
Analyse plage, Union(plage.Rows(1), plage.Columns(plage.Columns.Count)), -1
End Sub

Sub Analyse(plage As Range, zone As Range, sens As Integer)
Dim c As Range, diag As Range, i&, c1 As Range, flag As Boolean
For Each c In zone
  Set diag = c
  i = 0
  Set c1 = Nothing
  flag = False
  Do While Not Intersect(c.Offset(i, sens * i), plage) Is Nothing
    Set diag = Union(c.Offset(i, sens * i), diag)
    If c.Offset(i, sens * i) = "X" Then
      If c1 Is Nothing Then Set c1 = c.Offset(i, sens * i) Else flag = True
    End If
    i = i + 1
  Loop
  If flag Then
    diag.Borders(IIf(sens = 1, xlDiagonalDown, xlDiagonalUp)).Weight = xlThin
    c1.Font.ColorIndex = 3 'rouge
  End If
Next
End Sub

Sub Diagonales()
With [H2:Y18]
  .Borders(5).LineStyle = xlNone 'xlDiagonalDown
  .Borders(6).LineStyle = xlNone 'xlDiagonalUp
  .Font.ColorIndex = xlAutomatic
  Analyse .Cells, Union(.Columns(1), .Rows(1)), 1
  Analyse .Cells, Union(.Rows(1), .Columns(.Columns.Count)), -1
End With
End Sub

Sub Analyse(plage As Range, r As Range, sens As Integer)
Dim diag As Range, c As Range, flag As Boolean
For Each r In r
  Set diag = r
  Set c = Nothing
  flag = False
  While Not Intersect(r, plage) Is Nothing
    Set diag = Union(r, diag)
    If r = "X" Then If c Is Nothing Then Set c = r Else flag = True
    Set r = r.Offset(1, sens)
  Wend
  If flag Then
    diag.Borders(IIf(sens = 1, 5, 6)).Weight = xlThin
    c.Font.ColorIndex = 3 'diag.Font.ColorIndex = 3 'pour tout colorer
  End If
Next
End Sub