La macro continue même si on di non !!!!!!

Résolu/Fermé
mattparla - 2 déc. 2009 à 18:07
 mattparla - 3 déc. 2009 à 13:35
Bonjour,

J'ai un petit porblème ! quand je dis à la macro de se faire elle se fait et quand je la lance et que je lui dit c'est fini elle continue !!!!!

pouvez vous m'aider ?? La voici!! c'est vraiment basique je commence !

Je vous remercie !!!

Sub cestparti()
Dim Reponse As Integer
Reponse = MsgBox("Voulez-vous Jouer ?", vbYesNo + vbQuestion, "Question")
If Reponse = vbYes Then
Pour_jouer
Else
MsgBox "Bien, on ne fait rien finalement , hummm !!!", vbExclamation
End If
Exit Sub
End Sub


Sub attends(temps)
For i = 1 To temps
Next
End Sub


Sub Pour_jouer()Range("A1:Z26").Select
ActiveCell.Interior.ColorIndex = xlNone
Selection.ClearContents
For i = 1 To 20
'Permet de placer aléatoirement 3 chiffre 1 qui correspondend aux trésors
Dim lngMinL As Long
Dim lngMaxL As Long
Dim lngMinC As Long
Dim lngMaxC As Long
Dim lngAleaC As Long
Dim lngAleaL As Long
'Permet que le trésor ne soit pas confondu avec la montagen, la maison ou l'eau
Range("B2:Y25").Select
' numéro de la première colonne
LMinC = Selection.Columns(1).Column
' numéro de la dernière colonne
LMaxc = Selection.Columns.Count + LMinC - 1
' numéro de la première ligne
LMinL = Selection.Rows(1).Row
' numéro de la dernière ligne
LMaxL = Selection.Rows.Count + LMinL - 1
' tirage aléatoire pour la ligne
LAleaL = (LMaxL - LMinL) * Rnd + LMinL
' tirage aléatoire pour la colonne
LAleaC = (LMaxc - LMinC) * Rnd + LMinC
'Debug.Print "LMinC = " & LMinC, "LMaxC = " & LMaxC, "LMinL = " & LMinL, "LMaxL = " & LMaxL, "LAleaL = " & LAleaL, "LAleaC = " & LAleaC
'Permet d'écrire le chiffre 1 en blanc pour ne pas le voir
Cells(LAleaL, LAleaC).Activate
ActiveCell.Select
Selection.Font.ColorIndex = 2
ActiveCell.FormulaR1C1 = "1"
Next
plato
End Sub

Sub plato()
'Je crée mon plateau de jeu
Range("A1:Z26").Select
Selection.Interior.ColorIndex = 2
Range("A1:Y1,Z1:Z26,A26:Y26,A2:A25").Select
Selection.Interior.ColorIndex = 33
Range("E7:E20,F7:F20,G7:G8,G16:G20,H7:H10").Select
Selection.Interior.ColorIndex = 9
ActiveCell.Offset(14, 0) = "MONTAGNE"
Range("S15:S17,T15:T17").Select
Selection.Interior.ColorIndex = 9
ActiveCell.Offset(3, 0) = "MAISON"
CelluleAuHasard
End Sub

Sub CelluleAuHasard()
'Permet de lancer 20 bombes aléatoirement
For i = 1 To 20
Dim lngMinL As Long
Dim lngMaxL As Long
Dim lngMinC As Long
Dim lngMaxC As Long
Dim lngAleaC As Long
Dim lngAleaL As Long
Range("A1:Z26").Select
' numéro de la première colonne
LMinC = Selection.Columns(1).Column
' numéro de la dernière colonne
LMaxc = Selection.Columns.Count + LMinC - 1
' numéro de la première ligne
LMinL = Selection.Rows(1).Row
' numéro de la dernière ligne
LMaxL = Selection.Rows.Count + LMinL - 1
' tirage aléatoire pour la ligne
LAleaL = (LMaxL - LMinL) * Rnd + LMinL
' tirage aléatoire pour la colonne
LAleaC = (LMaxc - LMinC) * Rnd + LMinC
'Debug.Print "LMinC = " & LMinC, "LMaxC = " & LMaxC, "LMinL = " & LMinL, "LMaxL = " & LMaxL, "LAleaL = " & LAleaL, "LAleaC = " & LAleaC
'Les bombe ont une couleur orange
Cells(LAleaL, LAleaC).Activate
ActiveCell.Select
Selection.Interior.ColorIndex = 45
Next i
aventurier
End Sub


Sub aventurier()
Dim lngMinL As Long
Dim lngMaxL As Long
Dim lngMinC As Long
Dim lngMaxC As Long
Dim lngAleaC As Long
Dim lngAleaL As Long
'Je commence à mettre mon militaire aléatoirement sur le plato
Range("B2:Y6,B7:D25,E21:Y25,U7:Y20,H18:T20,G9:G15,H11:H17,I7:R17,S7:T14").Select
' numéro de la première colonne
LMinC = Selection.Columns(1).Column
' numéro de la dernière colonne
LMaxc = Selection.Columns.Count + LMinC - 1
' numéro de la première ligne
LMinL = Selection.Rows(1).Row
' numéro de la dernière ligne
LMaxL = Selection.Rows.Count + LMinL - 1
' tirage aléatoire pour la ligne
LAleaL = (LMaxL - LMinL) * Rnd + LMinL
' tirage aléatoire pour la colonne
LAleaC = (LMaxc - LMinC) * Rnd + LMinC
'Debug.Print "LMinC = " & LMinC, "LMaxC = " & LMaxC, "LMinL = " & LMinL, "LMaxL = " & LMaxL, "LAleaL = " & LAleaL, "LAleaC = " & LAleaC
'Permet de colorier mon aventurier en Vert
Cells(LAleaL, LAleaC).Activate
ActiveCell.Select
Selection.Interior.ColorIndex = 10
résultat
End Sub

Sub résultat()
'Diverses conditions qui permettent d'arréter le jeu ou de continuer
For i = 1 To 5E+18
attends (100000000)
ActiveCell.Offset(Rnd * 2 - 1, Rnd * 2 - 1).Select

If ActiveCell.Interior.ColorIndex = 10 Then
ActiveCell.Interior.ColorIndex = 10

Else:
If ActiveCell.Interior.ColorIndex = 16 Then
MsgBox "Tu es rentré à la maison sans trouver le trésor, continu"

Else:
If ActiveCell.Interior.ColorIndex = 9 Then
MsgBox "Tu est entrain de gravir la montagne, continu"

Else:
If ActiveCell.FormulaR1C1 = "1" Then
MsgBox "Tu as gagné !!! Tu as trouvé le trésor !!!"
ActiveCell.Interior.ColorIndex = 6
MsgBox "LE JEU EST FINI"

cestparti

Else:
If ActiveCell.Interior.ColorIndex = 2 Then
ActiveCell.Interior.ColorIndex = 10

Else:
If ActiveCell.Interior.ColorIndex = 45 Then
MsgBox "Tu as explosé sur une bombe"
Cells.Select
ActiveCell.Interior.ColorIndex = xlNone
Selection.ClearContents
MsgBox "Bah t'es nul !!!!"

cestparti

Else:
If ActiveCell.Interior.ColorIndex = 33 Then
MsgBox "Tu t'es noyé"
MsgBox "Bah t'es nul !!!!"

cestparti

End If
End If
End If
End If
End If
End If
End If
Next i
End Sub
A voir également:

2 réponses

Gord21 Messages postés 918 Date d'inscription samedi 21 novembre 2009 Statut Membre Dernière intervention 20 mars 2013 289
2 déc. 2009 à 18:39
Bonjour,
Tu as un soucis dans l'appel de tes fonctions. Tu commences par lancer cestparti. Avec OK, tu lances pourjouer puis à nouveau cestparti (dans resultat) alors que le premier cestparti n'est pas terminé.
A mon avis, si tu arrêtes plusieurs fois le jeu (environ 5e18 fois), il fini par s'arrêter.
Lorsque tu fais des boucles, assure toi d'en sortir.

Bon courage
0
Bonjour,

Merci de ta réponse!! j'ai réussi à régler le problème .
0