XL 2016 Construction du jeu de modus

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
P

papychat1

XLDnaute Nouveau
Supporter XLD
Bonjour le jeu de motus avance grace à l'aide de jurassic pork et de sylvanu
que je remercie encore pour les découvertes qu'ils m'ont apportées.
Rest que je voudrais maintenant que le curseur se place dans le première cellule vide de la ligne en cour
exemple au départ en b1 puisque le nouveau mot affiche la première lettre de celui-ci.
dès que je rentre une lettre donc en b1 celui-ci passe en c1 etc...
Après validation on passe en ligne 2 et en b2 puisque la première lettre s'affiche de part le code.
Tout cela en pouvant cependant garder un accès à ce curseur pour pouvoir éventuellement modifier une lettre.
Ok je suis exigent mais je vous remercie par avance.
Bien cordialement
un vieux qui essaye de mieux comprendre les formule vba ainsi que les fonctionnalités
 
Solution
P
Rheeem à dit:
Oui c'est la fonction de comparaison elle est rapide mais elle demande que la liste des mots soit toujours triée donc si tu decide d'ajouter des mots il faut appliquer un tri A-Z sur la colonne A.


C'est juste un code pour le test en réalité pour activer l'evenement OnselectionChange apres un arrêt forcé de débogage ..tu peux le retirer


On peut régler ce problème en interdisant l'ecrture dans la ligne suivante si le mot bon est trouvé : la condition motPropose <> motADeviner à ajouter
Code: 
           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...
Cliquez pour agrandir...
Trier par date Trier par votes
sylvanu à dit:
Ma stratégie au Modus n'est pas de faire des mots intermédiaires cohérents mais de déterminer les lettres présentes dans le mot final.
Si ça commence par T, alors mon premier mot sera du genre TAEIOUR, les voyelles pour déterminer lesquelles sont présentes, le R car souvent présent.
Donc votre contrôle pénaliserait certaines stratégies.
Cliquez pour agrandir...
Bonsoir,
Au "vrai" jeu de MOTUS, si le mot proposé n'est pas au dictionnaire, il n'est pas vérifié et la ligne est "brûlée", ce qui conduit à une tentative de moins pour trouver la bonne réponse.
Cordialement,
 
Vote positif 0 Vote négatif
c'est ce code qui permet la comparaison?
Cliquez pour agrandir...
Oui c'est la fonction de comparaison elle est rapide mais elle demande que la liste des mots soit toujours triée donc si tu decide d'ajouter des mots il faut appliquer un tri A-Z sur la colonne A.

Sub rrr()
Application.EnableEvents = True
MsgBox InStr("AZERT", "0")
End Sub
Cliquez pour agrandir...
C'est juste un code pour le test en réalité pour activer l'evenement OnselectionChange apres un arrêt forcé de débogage ..tu peux le retirer

Quand le mot est trouvé il s'inscrit une deuxième fois en dessous si ce n'est pas en ligne 6.
Cliquez pour agrandir...
On peut régler ce problème en interdisant l'ecrture dans la ligne suivante si le mot bon est trouvé : la condition motPropose <> motADeviner à ajouter
Code: 
           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

Mais comme j'ai ajouté une autre modification qui permet la selection automatique de la premiere cellule vide dans au passage à la ligne suivante car la cellule 2 ne pourrait pas etre toujours vide , donc .je poste le code entiere
VB: 
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
 
Vote positif 0 Vote négatif
Rheeem à dit:
Oui c'est la fonction de comparaison elle est rapide mais elle demande que la liste des mots soit toujours triée donc si tu decide d'ajouter des mots il faut appliquer un tri A-Z sur la colonne A.


C'est juste un code pour le test en réalité pour activer l'evenement OnselectionChange apres un arrêt forcé de débogage ..tu peux le retirer


On peut régler ce problème en interdisant l'ecrture dans la ligne suivante si le mot bon est trouvé : la condition motPropose <> motADeviner à ajouter
Code: 
           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

Mais comme j'ai ajouté une autre modification qui permet la selection automatique de la premiere cellule vide dans au passage à la ligne suivante car la cellule 2 ne pourrait pas etre toujours vide , donc .je poste le code entiere
VB: 
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
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Solution
Bonjour toujours sur la brèche!
Premièrement je vois que vous me vouvoyer, je suis désolé de vous avoir tutoyé,
c'est une habitude ancienne que l'on utilisait dans les forums.
Maintenant que dire de plus vous m'avez fait un cour de vba qui est parfait,
il ne me reste plus qu'à en faire le tour pour essayer d'en intégrer le maximum de fonctions
Un très grand merci à vous
Très bonne journée
Bien cordialement
 
Vote positif 0 Vote négatif
sylvanu à dit:
C'est quoi cette PJ ? Vous êtes parti sur quelle version ?
Cliquez pour agrandir...
Bonjour il s'agit de la version sudom -v2
Je viens de répondre a des commentaires pensant qu'il s'agissait de vous en fait c'est Rheeem.
Cependant merci et bonne journée
Quelle aide vous m'avez fournie.
Bien cordialement
JML

PS je rajoute un petit mot car je viens de m'apercevoir
que la sélection ne se fait que sur des mots de 7 lettres.
Où est le problème?
 
Dernière édition:
Vote positif 0 Vote négatif
Bonjour,
On ne met pas son propre post en vert. Le vert est là pour diriger le futur lecteur vers la solution.
papychat1 à dit:
Bonjour il s'agit de la version sudom -v2
Cliquez pour agrandir...
Donc elle n'intègre pas la vérif automatique en fin de mot. A mélanger toutes les versions vous allez avoir des soucis.
papychat1 à dit:
je rajoute un petit mot car je viens de m'apercevoir
que la sélection ne se fait que sur des mots de 7 lettres.
Où est le problème?
Cliquez pour agrandir...
Je ne sais pas. Précisez la version dont vous parlez.
Sur une des versions fournies, j'ai indiqué que j'ai réduit la liste de mot pour que la taille soit sous 1Mo.
 
Vote positif 0 Vote négatif
PS je rajoute un petit mot car je viens de m'apercevoir
que la sélection ne se fait que sur des mots de 7 lettres.
Où est le problème?
Cliquez pour agrandir...
C'est la cellule J2 qui fixe la longueur du mot aléatoire , malheureusement il n'est pas possible de la modifier sans afficher la colonne J ce qui est contraignant , alors si veut laisser au joueur la possibilité de choisir la longueur on pourrait ajouter une cellule disant L1 qui lui permet d'entrer la longueur ,,,et au début de macro ChoisirMotAleatoireFiltre ajouter Range("J2").Value = Range("L").Value pour modifier la valeur de J2.

Si on veut que la sélection des mots soit entièrement libre il faudrait adapter le code de ChoisirMotAleatoireFiltre

VB: 
' 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
 
Vote positif 0 Vote négatif
sylvanu à dit:
Bonjour,
On ne met pas son propre post en vert. Le vert est là pour diriger le futur lecteur vers la solution.

Donc elle n'intègre pas la vérif automatique en fin de mot. A mélanger toutes les versions vous allez avoir des soucis.

Je ne sais pas. Précisez la version dont vous parlez.
Sur une des versions fournies, j'ai indiqué que j'ai réduit la liste de mot pour que la taille soit sous 1Mo.
Cliquez pour agrandir...
La version suivante:
Mais je ne voudrais cependant abuser de votre bonne volonté.
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

P
  • Résolu(e)
XL 2016 jeu Motus
Réponses
12
Affichages
210
papychat1
P
P
  • Résolu(e)
XL 2016 Excel code vba motus
Réponses
11
Affichages
107
papychat1
P
M
  • Résolu(e)
XL 2021 Problème de version sur macro Excel 2010 - 2021
Réponses
12
Affichages
473
mamarus1
M
chaelie2015
  • Question Question
XL 2013 Filtrage automatique des résultats de recherche
Réponses
11
Affichages
395
TooFatBoy
TooFatBoy
T
  • Question Question
XL 2016 VBA listing de contacts
Réponses
1
Affichages
365
Dranreb
Dranreb
A
  • Question Question
Microsoft 365 Suppression du contenu de plusieurs cellules et remonter les cellules suivantes
Réponses
12
Affichages
675
Alain 79
A
K
  • Résolu(e)
XL 2013 recherche en fonction de la valeur et du rang sur une ligne
Réponses
5
Affichages
348
komarlehomard
K
oguruma
POWERQUERY :: Expression.Evaluate vs Record.Field :: Construction dynamique d'un nom de colonne à l'appel d'une fonction
Réponses
0
Affichages
380
oguruma
oguruma
N
  • Résolu(e)
Microsoft 365 Transfère de données d'un Userform vers un tableau structuré d'une feuille de calcul
Réponses
4
Affichages
285
NONO14
N
oguruma
POWERQUERY :: Importer un fichier .csv avec construction de critères dynamiques - V3.0 - Table.NestedJoin
Réponses
0
Affichages
282
oguruma
oguruma
M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
1 K
sousou
sousou
C
Clin d’œil de fin d’année : Palme d’Or du Festival XLD
Réponses
2
Affichages
255
jurassic pork
jurassic pork
C
  • Question Question
XL 2021 Cellules qui ne s'effacent pas sur formulaire et renvoi de valeurs du formulaire
Réponses
1
Affichages
381
gbinforme
G
herve62
  • Question Question
XL 2010 fonction vlookup réticente ? (vba) [RESOLU]
2 3
Réponses
34
Affichages
2 K
TooFatBoy
TooFatBoy
C
  • Question Question
XL 2013 Traitement sur chaîne de caractères
Réponses
9
Affichages
489
sylvanu
sylvanu
Saalut
  • Question Question
XL 2021 Pourriez m'aider s.v.p. à finaliser ce tableau
Réponses
6
Affichages
492
Saalut
Saalut
G
  • Question Question
XL 2021 rassembler des données de plusieurs feuilles d'un classeur sur une nouvelle feuille du meme classeur selon un critère
Réponses
1
Affichages
468
Staple1600
Staple1600
L
  • Question Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
374
AtTheOne
AtTheOne
R
  • Résolu(e)
XL 2016 Générateur mot de passe
Réponses
11
Affichages
754
Usine à gaz
Usine à gaz
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
529
arnoldbrice19
A
Retour