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 !
A voir également:

7 réponses

ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
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
jordane45
Messages postés
36088
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
18 août 2022
351
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
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
20
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
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
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
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
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
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
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