Changement de couleur de cellules comprises entre 2 cellules....

Option Explicit

Dim rngPlateau As Range
Dim Joueurs(2) As Integer
Dim NumJoueurEnCours As Integer

Sub Init()
'Les cellules en dehors du plateau n'ont pas de couleur
    'permet la sortie de boucle lorsque l'on arrive en bordure de plateau
Range("A1:AZ500").Interior.ColorIndex = -4142
'définit le plateau, l'aire de jeu
Set rngPlateau = Range("C4:Q23")
'colore toutes les cellules du plateau en blanc
    'pour différencier de l'extérieur du plateau de jeu
rngPlateau.Interior.ColorIndex = 2
'peint quelques cellules en noir, pour l'exemple
Range("G5").Interior.ColorIndex = 1
Range("D10").Interior.ColorIndex = 1
Range("P4").Interior.ColorIndex = 1
Range("K17").Interior.ColorIndex = 1
Range("L10").Interior.ColorIndex = 1
Range("M20").Interior.ColorIndex = 1
'définit la couleur des 3 joueurs
Joueurs(0) = 3
Joueurs(1) = 4
Joueurs(2) = 5
'numéro du joueur qui a la main
NumJoueurEnCours = 0
'sélection d'une cellule en dehors du plateau
Range("A1").Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Si la cellule sélectionnée ne fait pas partie du plateau de jeu, on quitte sans rien faire
If Intersect(rngPlateau, Target) Is Nothing Then Exit Sub
'ICI différents tests à faire...
If Target.Count > 1 Then Exit Sub

Dim Chemin As String, Coul As Integer

Coul = Joueurs(NumJoueurEnCours)
Target.Interior.ColorIndex = Coul

'Cherche le "Chemin" à colorier grâce à la fonction ci-dessous : Colore
    'paramètres :
    'target = Range(cellule cliquée) => cellule active
    '1 = décalage en ligne (pour vérifier la colonne il faut ajouter ou soustraire 1 au numéro de ligne)
    '0 = décalage de colonne
    'coul = couleur du joueur
'Colore La Colonne
Chemin = Colore(Target, 1, 0, Coul)
If Chemin <> "" Then Range(Chemin).Interior.ColorIndex = Coul
'Colore la ligne
Chemin = Colore(Target, 0, 1, Coul)
If Chemin <> "" Then Range(Chemin).Interior.ColorIndex = Coul
'colore la diagonale \
Chemin = Colore(Target, 1, 1, Coul)
If Chemin <> "" Then Range(Chemin).Interior.ColorIndex = Coul
'colore la diagonale /
Chemin = Colore(Target, -1, 1, Coul)
If Chemin <> "" Then Range(Chemin).Interior.ColorIndex = Coul

'joueur suivant
NumJoueurEnCours = NumJoueurEnCours + 1
If NumJoueurEnCours = 3 Then NumJoueurEnCours = 0
End Sub

'La fonction Colore va renvoyer le "chemin" si elle rencontre, dans son parcours
'la couleur du joueur qui vient de jouer.
'Elle est appelée 4 fois, horizontal, vertical et les deux diagonales
Function Colore(RngJoue As Range, pasH As Integer, PasV As Integer, Couleur As Integer) As String
Dim Lig As Integer, Col As Integer, Sens As Integer, CheminTemp As String, Flag As Boolean
Dim PremCouleur As Integer, CoulCelEnCours As Integer

'la cellule jouée est forcément colorée
Colore = RngJoue.Address
'Sens permet, dans le cas horizontal par exemple :
    'd'aller vers la droite, sens = -1
    'd'aller vers la gauche, sens = 1
For Sens = -1 To 1 Step 2
    'initialisation des variables
    'à chaque changement de sens
    Lig = 0
    Col = 0
    PremCouleur = 0
    Do
        Lig = Lig + (pasH * Sens)
        Col = Col + (PasV * Sens)
        'Cas de sortie de boucle :
            'couleur blanc : If RngJoue.Offset(Lig, Col).Interior.ColorIndex = 2
            'couleur noire : If RngJoue.Offset(Lig, Col).Interior.ColorIndex = 1
            'absence de couleur (en dehors du plateau) : If RngJoue.Offset(Lig, Col).Interior.ColorIndex = -4142
        'Ces 3 conditions se résument en une seule :
        If RngJoue.Offset(Lig, Col).Interior.ColorIndex < 3 Then Exit Do
        'PremCouleur représente la couleur de la première case rencontrée
        If PremCouleur = 0 Then 'Si première fois alors
            'on lui attribue la couleur de la case
            PremCouleur = RngJoue.Offset(Lig, Col).Interior.ColorIndex
        End If
        CoulCelEnCours = RngJoue.Offset(Lig, Col).Interior.ColorIndex
        'on va regarder le cas de la couleur de la cellule
        Select Case CoulCelEnCours
            Case PremCouleur 'cas ou elle est identique à la première couleur
                'si on rencontre plusieurs fois la couleur rencontrée dans la cellule
                'voisine de celle jouée, on stocke leurs adresses dans la variable CheminTemp
                CheminTemp = RngJoue.Offset(Lig, Col).Address & "," & CheminTemp
            Case Couleur 'cas ou l'on rencontre la couleur du joueur
                Flag = True
            Case Else 'autre cas (autre joueur)
                Exit Do
        End Select
    Loop While RngJoue.Offset(Lig, Col).Interior.ColorIndex <> Couleur
    'si le drapeau est levé, cela veut dire qu'on a rencontré la couleur du joueur
    'donc on enregistre le "chemin" réalisé
    If Flag = True Then Colore = CheminTemp & Colore Else CheminTemp = ""
Next Sens
End Function