Sujet Précédent Sujet Suivant

Tours de hanoï

Elcor Messages postés 4 Date d'inscription lundi 16 février 2015 Statut Membre Dernière intervention 24 février 2015 - Modifié par jordane45 le 16/02/2015 à 11:35
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 - 24 févr. 2015 à 19:02
Bonjour,

Mon prof ma donné un exercice à réaliser, cependant je ne comprend pas trop VBA :S

Voici le sujet:
http://www.vbfrance.com/codes/TOURS-HANOI-JEU-SOUS-EXCEL-VBA_53200.aspx

Quelques remarques :

1) je ne vous demande pas de reproduire le code que je vous ai fourni et qui fonctionne mais de le compléter : il s'agit donc de rajouter du code dans le classeur fourni.

En d'autres termes, il s'agit de ne pas toucher (ou le moins possible) à la fonction existante qui consiste à faire déplacer les disques par l'utilisateur mais de rajouter une fonction qui permettra au programme après avoir demandé le niveau du jeu de se substituer à l'utilisateur pour décider à partir de l'algorithme récursif des déplacements à effectuer.

Une fois le niveau choisi, il n'y a plus d'intervention de l'utilisateur jusqu'à ce que le programme se termine; c'est à dire jusqu'au moment où tous les disques ont atteint la pile d'arrivée et ceci bien sûr quelque soit le niveau de jeu choisi

En début de partie ou à la fin d'une partie, l'utilisateur peut choisir de "jouer" ou de faire jouer le programme. Le bouton qui permet de faire jouer l'utilisateur, existe; il faut donc ajouter un bouton qui va déclencher le programme récursif. Dans un cas comme dans l'autre c'est à dire qu'il choisisse de jouer ou de faire jouer l'ordinateur, l'utilisateur aura à indiquer le niveau du jeu qui détermine le nombre de disques à déplacer.

2) test de lalgorithme récursif ; pour comprendre cet algorithme, je vous invite à tester le code qui se trouve ci-dessous dans un nouveau classeur (classeur vierge) puis une fois que vous vous serez approprié ce code, intégrez le dans le classeur fourni. Remplacer les instructions qui permettent l'affichage des messages dans une boîte de dialogue par celles qui vont commander le déplacement des disques dans l'interface proposée. (on doit voir le disque se déplacer d'une pile à une autre comme si l'utilisateur avait cliqué sur la flêche située au dessus de la pile de départ puis sur celle située au dessus de la pile d'arrivée)

3) Ajouter le code permettant de Tracer chaque déplacement dans le champ Trace de l'onglet Trace 


Option Explicit

Public n As Integer   ' nombre de disques utilisés
Public D As Byte '  emplacement de départ
Public A As Byte '  emplacement d'arrivée
Public I As Byte '  emplacement intermédiaire
Sub Lancer_Hanoi()
D = 1
A = 3
I = 2
n = Application.InputBox("Nombre de disques", Title:="Hanoï", Type:=1)
Call Hanoi(n, D, A, I)
End Sub
'

Sub Hanoi(n, D, A, I)
  
   'si n = 1
   'alors
   '     Deplacer le disque de D vers A
   ' sinon
   '     Hanoi(n-1,D,I,A)
   '     Deplacer le disque de D vers A
   '     Hanoi(n-1,I,A,D)
   ' fin -du - si
    If n = 1 Then
        MsgBox ("Deplacer le disque de " & D & " vers " & A)
    Else
        Call Hanoi(n - 1, D, I, A)
        MsgBox ("Deplacer le disque de " & D & " vers " & A)
        Call Hanoi(n - 1, I, A, D)
    End If
End Sub


Voila tout le sujet qui ma été donné, si vous pouvez m'aider ce serais vraiment très sympa.

Bonne journée :)



EDIT : Ajout des balises de code !

7 réponses

Réponse 1 / 7
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 24/02/2015 à 19:03

Erase I, J

Puis la pile sera remise à zéro ?


C'est ce que tu as lu dans l'aide VBA, çà ???
Bonne chance. Moi, je t'abandonne là.

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
1
Réponse 2 / 7
jordane45 Messages postés 38138 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 17 avril 2024 344
16 févr. 2015 à 11:37
Bonjour,

1 - Merci de bien vouloir utiliser la coloration syntaxique (les balises de code) lorsque tu postes du code sur le forum.
Explications disponibles ici :
http://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code

2 - http://www.commentcamarche.net/faq/10925-demander-de-l-aide-pour-vos-exercices-sur-ccm

2 bis - http://codes-sources.commentcamarche.net/forum/affich-1557761-bar-sujet-de-pfe-tp-et-autres-devoirs-scolaires#top


Et donc .......
Nous pouvons t'aider .... MAIS .. nous ne ferons pas l'exercice pour toi !
Ici... nous ne faisons qu'aider sur des points techniques PRECIS !
Tu dois donc reformuler ta question en indiquant sur quel point exactement tu bloques (code à l'appui) et en nous indiquant ce que tu as essayé de faire !

0
Réponse 3 / 7
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
16 févr. 2015 à 15:17
J'ajouterais que tu déclares des variables Public et tu les passes en paramètre à ta Sub Hanoi, ce qui n'est pas nécessaire.

Par contre, c'est toujours mieux de déclarer les variables localement dans la Sub et de les passer en paramètre. Tu pourrais donc les déclarer dans la Sub Lancer_Hanoi et laisser les paramètres tels quels...
0
Réponse 4 / 7
Elcor Messages postés 4 Date d'inscription lundi 16 février 2015 Statut Membre Dernière intervention 24 février 2015
24 févr. 2015 à 17:25 
Option Explicit

'Mon troisième code utilisant VBA sous excel, soyez indulgent! :)
'mail: r.toky.olivier@gmail.com
' Trois mots utilisés en "mémoire" permettant l'usage de certaines parties du programme
Public ModA As Byte 'Bit mémoire pour empêcher les étapes lié au joueur humain
Public ModB As Byte ' Bit mémoire pour empêcher les boites de dialogues lors d'un recommencer niveau + 1
Public ModC As Byte 'Mémoire trace
' permettent la récursivité
Public na As Integer   ' nombre de disques utilisés
Public Da As Byte '  emplacement de départ
Public Aa As Byte '  emplacement d'arrivée
Public Ia As Byte '  emplacement intermédiaire
' Permettent le programme Hanoi "lclassique"
Public Piquet As Integer
Public Selected As Integer
Public Disque(1 To 3, 1 To 8) As Integer
Public NbrDisques(1 To 3) As Integer
Public NbrCoups As Integer
Public Niveau As Integer
' valeur utilisées dans le mot "Mot" pour la Trace
Public PpA As Byte 'emplacement prise de départ Trace
Public PpB As Byte 'emplacement prise d'arrivée Trace
Public Mc As Integer 'Mot utilisé pour le décalage de case des phrases pour trace
'position cartésienne Ms pour la prise, Mp pour la dépose
Public Mpx As Integer ' position prise x
Public Mpy As Integer ' position prise y
Public Mpz As Integer ' position prise z
Public Mdx As Integer ' position pose x
Public Mdy As Integer ' position pose y
Public Mdz As Integer ' position pose z
' Mots affichant les phrases dans l'onglet feuil1 pour la Trace
Public MotP As String ' phrase prise
Public MotD As String ' phrase dépose
Public Mot As String ' phrase complétant les emplacements trace
'Mots permettant la reprise des valeurs de position départ/arrivée
Public MDa As Byte 'mémoire position de départ
Public MAa As Byte 'mémoire position arrivée
Public Mna As Byte ' valeur courante de na

Public ret As Integer 'permet la l'écriture de la troisième boucle

'Mots permettant la reprise des valeurs de Nbrdisques pour les phrases Trace
Public posdiscS As Integer 'variable position courante nbrdisque sub soulever
Public posdiscP As Integer 'variable position courant Nbrdisque sub poser

Sub AfficherBas() 'Afficher les flêches bas
If ModA = 0 Then
    Dim myDocument As Object
    Set myDocument = Worksheets(1)

    myDocument.Shapes.Range(Array("AutoShape 2", "AutoShape 3", "AutoShape 4")).Visible = False 'pour trouver les noms des formes automatiques (flèche, etc...), sélectionner la forme et lire sur la barre de référence
    myDocument.Shapes.Range(Array("AutoShape 5", "AutoShape 6", "AutoShape 7")).Visible = True
End If
End Sub

Sub AfficherHaut() 'Afficher les flêches hauts
If ModA = 0 Then
    Dim myDocument As Object
    Set myDocument = Worksheets(1)

    myDocument.Shapes.Range(Array("AutoShape 2", "AutoShape 3", "AutoShape 4")).Visible = True
    myDocument.Shapes.Range(Array("AutoShape 5", "AutoShape 6", "AutoShape 7")).Visible = False
End If
End Sub

Sub AfficherTout() 'Afficher les flêches , ce n'est pas necessaire :)
Dim myDocument As Object
Set myDocument = Worksheets(1)

 myDocument.Shapes.Range(Array("AutoShape 2", "AutoShape 3", "AutoShape 4")).Visible = True
 myDocument.Shapes.Range(Array("AutoShape 5", "AutoShape 6", "AutoShape 7")).Visible = True
End Sub

Sub CacherTout() 'Cacher les flêches , ce n'est pas necessaire :)
Dim myDocument As Object
Set myDocument = Worksheets(1)

 myDocument.Shapes.Range(Array("AutoShape 2", "AutoShape 3", "AutoShape 4")).Visible = False
 myDocument.Shapes.Range(Array("AutoShape 5", "AutoShape 6", "AutoShape 7")).Visible = False
End Sub

Sub EffacerTout()
With Sheets("Hanoi")
    .Unprotect
    .Range("B5:U23").Interior.Color = RGB(153, 255, 153)
    .Range("K12:L22").Interior.Color = RGB(160, 160, 160)
    .Range("W5:AP23").Interior.Color = RGB(153, 255, 153)
    .Range("AF12:AG22").Interior.Color = RGB(160, 160, 160)
    .Range("AR5:BK23").Interior.Color = RGB(153, 255, 153)
    .Range("BA12:BB22").Interior.Color = RGB(160, 160, 160)
    .Protect
End With
End Sub

Sub DessinerPiles() 'dessiner les piles
Dim I, j, k As Integer
Dim x, y, z As Integer
Dim myDocument As Object
Set myDocument = Worksheets(1)
myDocument.Unprotect
For j = 1 To 3 'numero de Piquet
 k = 0
 For I = 1 To 8 'hauteur de Pile
  If Disque(j, I) > 0 Then
   k = k + 1
   Select Case j
    Case 1: 'Piquet num 1
    x = 22 - k
    y = 11 - Disque(j, I)
    z = 12 + Disque(j, I)
    Case 2: 'piquet 2
    x = 22 - k
    y = 32 - Disque(j, I)
    z = 33 + Disque(j, I)
    Case 3: 'piquet 3
    x = 22 - k
    y = 53 - Disque(j, I)
    z = 54 + Disque(j, I)
   End Select
myDocument.Range(myDocument.Cells(x, y), myDocument.Cells(x, z)).Interior.ColorIndex = 1 'On dessine le disque
  End If
 Next I
Next j
myDocument.Protect
End Sub

Sub Soulever(tig As Integer) 'on soulève un disque
Dim myDocument As Object
Set myDocument = Worksheets(1)
Dim j, k As Integer  'valeur variables soulever
Dim x, y, z As Integer

ActiveSheet.Unprotect 'enlève la protection sur la feuille pour pouvoir faire des modification

 If NbrDisques(tig) > 0 Then
    posdiscS = NbrDisques(tig)
    AfficherBas 'afficher les flêches bas
    Selected = Disque(tig, NbrDisques(tig)) 'selected: le disque choisi
    coordonées_mot_prise 'appel de la maccro liée à Trace
    Disque(tig, NbrDisques(tig)) = 0 'on enlève le disque du piquet
    NbrDisques(tig) = NbrDisques(tig) - 1 'on décrémente le nombre disques sur le piquet choisi
    EffacerTout 'on nettoie tout
    DessinerPiles 'et redessine toutes les piles
myDocument.Unprotect
myDocument.Range("C6:T6,X6:AO6,AS6:BJ6").Interior.ColorIndex = 35 'effacer le disque soulever, on utilise la couleur du fond

k = Selected
  For j = 1 To 3
   Select Case j
    Case 1:
    x = 6
    y = 11 - k
    z = 12 + k
    Case 2:
    x = 6
    y = 32 - k
    z = 33 + k
    Case 3:
    x = 6
    y = 53 - k
    z = 54 + k
   End Select
myDocument.Range(myDocument.Cells(x, y), myDocument.Cells(x, z)).Interior.ColorIndex = 1
  Next j
 End If
 
 Range("A1").Select
 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'on protège la feuille
End Sub

Sub VerifierFin() 'Vérification si on a terminé le niveau ou le jeu
If ModA = 0 Then
 Dim I As Integer
 Dim TheEnd As Boolean
 TheEnd = True
 For I = 1 To Niveau
  If Disque(3, I) <> 8 - I + 1 Then 'si un disque est malplacé, alors le niveau n'est pas terminé
   TheEnd = False
   Exit For
  End If
 Next I
 If TheEnd Then 'fin du niveau
  If Niveau = 8 Then 'fin du jeu
   MsgBox "Félicitation!", , "Hanoi"
  Else
   If MsgBox("Gagné! Voulez-vous passez au niveau suivant?", vbYesNo, "Hanoi") = vbYes Then 'Recommencer
    Niveau = Niveau + 1 'mais le niveau est incrémenté de 1
    InitGame (Niveau)
    AfficherHaut
    DessinerPiles
   End If
  End If
 End If
End If
End Sub

Sub Poser(tig As Integer)
If Selected = 0 Then Exit Sub 'si rien n'a été choisi, alors, ne fait rien
If NbrDisques(tig) > 0 Then
If Disque(tig, NbrDisques(tig)) < Selected Then Exit Sub 'et on fait de même si le disque sur le piquet est plus petit que celui choisi
End If

Dim myDocument As Object
Set myDocument = Worksheets(1)

myDocument.Unprotect

NbrDisques(tig) = NbrDisques(tig) + 1 'on augmente le nombre de disque sur le piquet
Disque(tig, NbrDisques(tig)) = Selected 'on met le disque choisi
posdiscP = NbrDisques(tig)
coordonées_mot_pose
EffacerTout 'on efface tout
DessinerPiles ' et redessine le jeu
myDocument.Unprotect
myDocument.Range("C6:T6,X6:AO6,AS6:BJ6").Interior.ColorIndex = 35 'on efface la place pour le disque choisi

AfficherHaut
Selected = 0
 
NbrCoups = NbrCoups + 1 'augmente le nombre de coups
Worksheets(1).Shapes("AutoShape 10").TextFrame.Characters.Text = Format(NbrCoups, "000") 'et affiche ensuite ce nombre de coups
 
VerifierFin 'on vérifie la fin du jeu
Range("A1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'et on protège la feuille
myDocument.Protect
End Sub

Sub InitGame(niv As Integer) 'initialisation du jeu
Dim I As Integer, j As Integer
Dim myDocument As Object
Set myDocument = Worksheets(1)
Mc = 0
Dim Best(1 To 6) As Integer 'Meilleurs coups (plus petit) que J'AI PU FAIRE, peut-être que vous pouvez faire mieux
For I = 1 To 3
 For j = 1 To 8
  Disque(I, j) = 0 'remise à zéro de chaque pile
 Next j
Next I
For I = 1 To niv 'initialisation des disques sur la pile la plus à gauche
 Disque(1, I) = 8 - I + 1
Next I
NbrDisques(1) = niv
NbrDisques(2) = 0
NbrDisques(3) = 0

Best(1) = 7 'En jouant, j'ai trouvé que les meilleurs coups pour chaque niveau est de: 7,15,31,63,127,255... Une suite: U(n+1)=U(n)*2+1
For I = 2 To 6 'Je ne sais pas si vous pouvez trouvez mieux mais bon!!!
 Best(I) = Best(I - 1) * 2 + 1
Next I 'Comme ça, vous pouvez augmenter le niveau 7, 8, 9, 10 ...

NbrCoups = 0
With myDocument
    .Unprotect
    .Shapes("AutoShape 10").TextFrame.Characters.Text = Format(NbrCoups, "000") 'raz du nombre de coups
    .Shapes("AutoShape 11").TextFrame.Characters.Text = Format(Best(niv - 2), "000") 'on affiche le Best pour chaque niveau
    .Protect
End With
EffacerTout

End Sub

Sub Formeautomatique12_QuandClic() 'Le numéro 12 a été modifié... Il y avait une erreur sur la fiche on a du remplacer toutes les formaes automatique...
 Piquet = 1 'numéro du piquet, juste pour faciliter la lecture, on peut bien mettre Poser(1)
 Poser (Piquet)
End Sub

Sub Formeautomatique14_QuandClic()
 Piquet = 2
 Poser (Piquet)
End Sub

Sub Formeautomatique11_QuandClic()
 Piquet = 3
 Poser (Piquet)
End Sub

Sub Formeautomatique10_QuandClic()
 Piquet = 1
 Soulever (Piquet)
End Sub

Sub Formeautomatique9_QuandClic()
 Piquet = 2
 Soulever (Piquet)
End Sub

Sub Formeautomatique7_QuandClic()
 Piquet = 3
 Soulever (Piquet)
End Sub

Sub Formeautomatique18_QuandClic() 'Nouveau jeu!
 Dim s As String, n As Integer
 ActiveSheet.Unprotect 'enlève la protection
1:
 s = InputBox("Entrer le niveau (1-6):", "Hanoi")
 If s = "" Then Exit Sub
 n = Val(s)
 If n < 1 Or n > 6 Then
  MsgBox "Veuillez entrer un niveau entre 1 à 6!"
  GoTo 1
 End If
 n = n + 2 'Niveau 1 -> Nombre de disque = 3 et ainsi de suite
 Niveau = n
 InitGame (n) 'initialisation du jeu
 AfficherHaut 'afficher les flêches hauts pour commencer
 DessinerPiles 'dessiner les piles
 Range("A1").Select
 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'protéger la fiche
End Sub

Sub Lancer_Hanoi()
ModA = 1
If ModB = 0 Then
    Mode_automatique
Else
    Mode_automatique_Nouveau_niveau
End If
Da = 1
Aa = 3
Ia = 2
na = Niveau
Call Hanoi(na, Da, Aa, Ia)
End Sub

Sub Hanoi(na, Da, Aa, Ia)
Dim y As Integer
Dim z As Integer ' Variable de l'algorithme f(x)=2^X-1

valeur_ret

    If na = 1 Then 'si n = 1 alors
        MsgBox ("Deplacer le disque de " & Da & " vers " & Aa) 'Deplacer le disque de D vers A
        Soulever (Da) 'Appel de la maccro soulever en position Da
        Poser (Aa) 'Appel de la maccro Poser en position Aa
        If ModC = 1 Then 'Si Trace activé
            ret = 0 'utilisation de ret
            Mna = na
            PpA = Da
            PpB = Aa
            MDa = Da
            MAa = Aa
            ABBA
        End If
        VerifierFin_Auto
    Else
        Call Hanoi(na - 1, Da, Ia, Aa) 'Hanoi(n-1,D,I,A)-> récursivité
        MsgBox ("Deplacer le disque de " & Da & " vers " & Aa) 'Deplacer le disque de D vers A
        Soulever (Da)
        Poser (Aa)
        If ModC = 1 Then
            Mna = na
            PpA = Da
            PpB = Aa
            MDa = Da
            MAa = Aa
            ABBA
        End If
        Call Hanoi(na - 1, Ia, Aa, Da) 'Hanoi(n-1,I,A,D)-> récursivité
        If ModC = 1 Then 'Si Trace activé
            If ret = 1 Then
                Mna = na
                PpA = Da
                PpB = Aa
                MDa = Da
                MAa = Aa
                ABBA
                ret = 0
            End If
        End If
    End If
End Sub

Sub ABBA()
            Mot = "Le disque " & Mna & " est déplacé de la pile " & PpA & " Vers la pile " & PpB  'Implementation de Mot
            MotD = "Pose en " & MAa & ", Disque N° " & (Mdx) & ", Colonne N°" & (Mdy) & ", Position " & (Mdz) 'implementation de la valeur de MotD
            MotP = "Prise en " & MDa & ", Disque N° " & (Mpx) & ", Colonne N°" & (Mpy) & ", Position " & (Mpz) 'implementation de la valeur de MotP
            With Sheets("Feuil1")
                .Unprotect 'retire la protection en écriture
                .Range("A5").Offset(Mc, 0) = Mot
                .Range("A6").Offset(Mc, 0) = MotP
                .Range("A7").Offset(Mc, 0) = MotD
                .Protect
            End With
            Mc = Mc + 3
End Sub

Sub valeur_ret()
If NbrCoups = 2 ^ Niveau - 2 Then

ret = 1
End If
End Sub

Sub coordonées_mot_prise()
Dim b As Integer 'variable égale à selected utilisée pour cette maccro
Dim a As Integer
Dim n As Integer

b = Selected
n = 9
a = n - b

If Da = 1 Then
    Mpx = a
    Mpy = 1
    Mpz = posdiscS
Else
    If Da = 2 Then
        Mpx = a
        Mpy = 2
        Mpz = posdiscS
    Else
        Mpx = a
        Mpy = 3
        Mpz = posdiscS
    End If
End If
End Sub

Sub coordonées_mot_pose()
Dim b As Integer 'variable égale à selected utilisée pour cette maccro
Dim a As Integer
Dim n As Integer

b = Selected
n = 9
a = n - b

If Aa = 1 Then
    Mdx = a
    Mdy = 1
    Mdz = posdiscP
Else
    If Aa = 2 Then
        Mpx = a
        Mpy = 2
        Mpz = posdiscP
    Else
        Mdx = a
        Mdy = 3
        Mdz = posdiscP
    End If
End If
End Sub

Sub Mode_automatique() 'Nouveau jeu mode auto!
 Dim s As String, n As Integer
 ActiveSheet.Unprotect 'enlève la protection

1:
 s = InputBox("Entrer le niveau (1-6):", "Hanoi")
 If s = "" Then Exit Sub
 n = Val(s)
 If n < 1 Or n > 6 Then
  MsgBox "Veuillez entrer un niveau entre 1 à 6!"
  GoTo 1
 End If
 n = n + 2 'Niveau 1 -> Nombre de disque = 3 et ainsi de suite
 Niveau = n
 InitGame (n) 'initialisation du jeu
 DessinerPiles 'dessiner les piles
 Range("A1").Select
 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'protéger la fiche
End Sub

Sub Mode_automatique_Nouveau_niveau() 'Nouveau jeu mode auto! equivalent de mode auto, modif relatives au nouveau niveau
 Dim s As String, n As Integer
 ActiveSheet.Unprotect 'enlève la protection
 InitGame (Niveau) 'initialisation du jeu
 DessinerPiles 'dessiner les piles
 Range("A1").Select
 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'protéger la fiche
End Sub

Sub VerifierFin_Auto() 'Vérification si on a terminé le niveau ou le jeu en auto
If ModA = 1 Then
        Dim I As Integer
        Dim TheEnd As Boolean
        TheEnd = True
        For I = 1 To Niveau
            If Disque(3, I) <> 8 - I + 1 Then 'si un disque est malplacé, alors le niveau n'est pas terminé
                TheEnd = False
                Exit For
            End If
        Next I
        If TheEnd Then 'fin du niveau
            If Niveau = 8 Then 'fin du jeu
                MsgBox "Félicitation ! Vous avez terminé le jeu.", , "Hanoi"
                ModA = 0 ' mise à Zéro des mots utilisés dans les différentes maccros
                ModB = 0
                ModC = 0
            Else
                If MsgBox("Gagné! Voulez-vous passez au niveau suivant?", vbYesNo, "Hanoi Automatique") = vbYes Then 'Recommencer
                    ModB = 1
                    Niveau = Niveau + 1 'mais le niveau est incrémenté de 1
                    InitGame (Niveau) 'nouvelle initialisation du jeu
                    DessinerPiles   'Appel de dessiner piles pour être sûr de la "propreté" du jeu
                    Lancer_Hanoi    'Démarrer le jeu automatique
                Else
                    MsgBox "Game Over", , "Hanoi Automatique"
                    Niveau = 0 ' mise à Zéro des mots utilisés dans les différentes maccros
                    CacherTout 'appel de la maccro qui va efacer les flèches
                End If
                    ModA = 0 ' mise à Zéro des mots utilisés dans les différentes maccros
                    ModB = 0
                    ModC = 0
            End If
        End If
End If
End Sub

Sub trace() 'appui sur le bouton trace
ModC = 1 'mot ModC = 1 permet de continuer dans certains module
MsgBox " Le résultat se trouve dans l'onglet Résultats" 'permet de montrer que l'action est prise en compte
End Sub

Sub Clear()
With Sheets("Feuil1")
    .Unprotect
    .Range("A5:A260").ClearContents 'Efface le résultat précédent de trace
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'protéger la fiche
End With
End Sub

'debug
Sub blblblblb()
ModC = 0
End Sub

Sub retirer_protection()
ActiveSheet.Unprotect
End Sub

Sub mettre_protection()
ActiveSheet.Protect
End Sub

Sub blanc()
ActiveSheet.Unprotect
Range("B5:BK23").Interior.ColorIndex = 2
ActiveSheet.Protect
End Sub





Voila j'ai rajouté une trace, dite moi si vous trouvé quelque amélioration a rajouter :)

merci d'avance
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 24/02/2015 à 18:16
Bonjour,
dite moi si vous trouvé quelque amélioration a rajouter :)


Il y en aurait beaucoup trop.

J'en prends une au hasard : 
For I = 1 To 3
  For j = 1 To 8
   Disque(I, j) = 0 'remise à zéro de chaque pile
  Next j
Next I

ouvre ton aide VBA sur le mot Erase. (en te rappelant que tu as typé le tableau disque en integer)
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend
0
Elcor Messages postés 4 Date d'inscription lundi 16 février 2015 Statut Membre Dernière intervention 24 février 2015
24 févr. 2015 à 18:28
Bonsoir,

pouvez-vous m'expliquer ,car sur le coup je suis perdu
0
Réponse 6 / 7
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
24 févr. 2015 à 18:50
Tu me demandes de t'expliquer quoi ? ce qu'expose à la perfection ton aide VBA ?
Commence par la lire et dis-moi ensuite ce que tu n'y as pas compris.
Je viens d'ailleurs de le faire moi-même. Non seulement elle est très claire, mais elle est assortie d'exemples dont l'un, d'un tableau numérique !
0
Réponse 7 / 7
Elcor Messages postés 4 Date d'inscription lundi 16 février 2015 Statut Membre Dernière intervention 24 février 2015
24 févr. 2015 à 19:00 
For I = 1 To 3
  For j = 1 To 8
   Disque(I, j) = 0 'remise à zéro de chaque pile
  Next j
Next I


donc suite à l'exemple de l'aide de Visual Basic j'écris simplement: 

Erase I, J


Puis la pile sera remise à zéro ?
0

Discussions similaires

exercices et corrigés
amerprod89 -
ed73 -

1 réponse
Exercice sur Pointeurs, classes, héritage...
snoozriton -
snoozriton -

14 réponses
relier par une fleche
alias100 -
alias100 -

4 réponses
QCM
cs_naddouchka -
nicomilville -

3 réponses
Programme d'un jeu de la Vie en Python !
Boumiz -
hbouia -

1 réponse
Rejoignez-nous