XL 2016 Construction du jeu de modus

           If (ligne < 6) And (motPropose <> motADeviner) Then   ' coloration de la ligne suivante uniquiment les lettres valides
              ws.Cells(ligne + 1, I) = Mid(motADeviner2, I, 1)  ' Vert
              ws.Cells(ligne + 1, I).Interior.Color = RGB(0, 255, 0) ' Vert
           End If

Sub VerifierMotus()
    Dim ws As Worksheet
    Dim ligne As Integer
    Dim colonne As Integer
    Dim motPropose As String, motPropose2 As String
    Dim Lettre As String
    Dim motADeviner As String, motADeviner2  As String
    Dim longueurMot As Integer
    Dim I As Integer, j As Integer
  
    Set ws = Worksheets("Jeu")      ' Feuille de jeu (active par défaut)
    
    ' Récupérer le mot à deviner depuis la cellule J1
    motADeviner = UCase(ws.Range("J1").Value)
    longueurMot = Len(motADeviner) ' Calculer la longueur du mot
        
    ' Vérifier que la longueur du mot proposé correspond à celle du mot à deviner
    If Len(motADeviner) <> ws.Range("J2").Value Then
        MsgBox "Dysfonctionnement dans le jeu", vbExclamation
        Exit Sub
    End If
    
    ligne = ALigne ' Ligne active où la tentative est saisie
 
    ' Construire le mot proposé par l'utilisateur
    For colonne = 1 To longueurMot
        If IsEmpty(ws.Cells(ligne, colonne)) Then
            MsgBox "Veuillez remplir toutes les cases avant de valider.", vbExclamation
            Exit Sub
        End If
        motPropose = motPropose & UCase(ws.Cells(ligne, colonne).Value)
    Next colonne
    
   ' Vérifier le mot dans le dico
    If BSearch(motPropose) = 0 Then
       MsgBox "Mot incorrect: " & motPropose
       AColonne = 2
       ws.Cells(ligne, 1).Resize(1, longueurMot).ClearContents ' supprime le mot incorrect
       ws.Cells(ligne, 1).Value = Mid(motADeviner, 1, 1)
       ws.Cells(ligne, 2).Select
       Exit Sub
    End If
    
    ' Vérifier si le mot est trouvé
    If motPropose = motADeviner Then
        ws.Cells(ligne, 1).Resize(1, longueurMot).Interior.Color = RGB(0, 255, 0) ' Vert
        MsgBox "Bravo ! Vous avez trouvé le mot !", vbInformation
        Exit Sub
    End If
    
    ' Vérifier la correspondance lettre par lettre
    motADeviner2 = motADeviner
    motPropose2 = motPropose
    For I = 1 To longueurMot
        If Mid(motADeviner2, I, 1) = Mid(motPropose, I, 1) Then
           ws.Cells(ligne, I).Interior.Color = RGB(0, 255, 0) ' Vert
           If ligne < 6 Then   ' coloration de la ligne suivante uniquiment les lettres valides
              ws.Cells(ligne + 1, I) = Mid(motADeviner2, I, 1)  ' Vert
              ws.Cells(ligne + 1, I).Interior.Color = RGB(0, 255, 0) ' Vert
           End If
           Mid$(motADeviner2, I, 1) = "?"
           Mid$(motPropose2, I, 1) = "?"
        End If
    Next I
    
    For I = 1 To longueurMot
        Lettre = Mid(motPropose2, I, 1)
        If Lettre <> "?" Then
            j = InStr(motADeviner2, Lettre)
            If j <> 0 Then ' Lettre n'est pas à la bonne position
               ws.Cells(ligne, I).Interior.Color = RGB(255, 255, 0) 'Jaune
               Mid$(motADeviner2, j, 1) = "?"
            Else
               ws.Cells(ligne, I).Interior.Color = RGB(200, 200, 200) ' Gris
            End If
        End If
    Next
        
    ' Gestion du passage à la ligne suivante et recopie de la première lettre en colonne A
    If ligne < 6 Then
        ALigne = ALigne + 1
        AColonne = 1
        ws.Cells(ALigne, 1).Value = Mid(motADeviner, 1, 1)  ' Copier la première lettre en A
        For I = 1 To longueurMot ' selection de la premiere cellule non vide dans la ligne suivante
           If ws.Cells(ALigne, AColonne) = "" Then Exit For
           AColonne = AColonne + 1
        Next
        ws.Cells(ALigne, AColonne).Select
    Else
        MsgBox "Échec ! Le mot était " & motADeviner, vbExclamation
    End If
End Sub

' Fonction pour sélectionner un mot aléatoire de 5 à 9 lettres
Sub ChoisirMotAleatoireFiltre()
    Dim wsMots As Worksheet
    Dim wsJeu As Worksheet
    Dim dernierMot As Long
    Dim longueurMot As Long
    Dim ligne As Long, I As Long
    Dim motSelectionne As String
    Dim motCourant As String
  
    ReinitialiserJeu
    ' Initialisation des feuilles
    Set wsMots = Worksheets("Mots") ' Feuille contenant les mots
    Set wsJeu = Worksheets("Jeu")      ' Feuille de jeu (active par défaut)
    
    ' Trouver le dernier mot dans la colonne A de la feuille "Mots"
    dernierMot = wsMots.Cells(wsMots.Rows.Count, "A").End(xlUp).Row

    ' Vérifier s'il y a au moins un mot dans la liste
    If dernierMot < 1 Then
        MsgBox "La liste des mots est vide. Veuillez ajouter des mots dans la feuille 'Mots'.", vbExclamation
        Exit Sub
    End If
 
    ' Sélectionner un mot aléatoire dans les mots valides
    Randomize ' Initialiser le générateur de nombres aléatoires
    Do
       motSelectionne = wsMots.Cells(Int(dernierMot * Rnd) + 1, 1)
       longueurMot = Len(motSelectionne)
    Loop Until (longueurMot >= 5) And (longueurMot <= 9)
    ' Récupérer la longueur du mot dans J2
    wsJeu.Range("j1").Value = motSelectionne
    wsJeu.Range("J2").Value = longueurMot
    
    ' Copier le premier caractère dans A1
    wsJeu.Range("A1").Value = Left(motSelectionne, 1)

    ' Appliquer les bordures et le style à la sélection
    With wsJeu.Range("A1").Resize(6, longueurMot)
        .Borders.Weight = xlContinuous
        .Borders.LineStyle = 1
        With .Interior
            .Pattern = xlSolid
            .ThemeColor = xlThemeColorAccent5
            .TintAndShade = 0.8
        End With
    End With
    wsJeu.Range("b1").Select
End Sub