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
Gord21
Messages postés918Date d'inscriptionsamedi 21 novembre 2009StatutMembreDernière intervention20 mars 2013289 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.