jeu calcul

Question

Bonjour, 

je voudrais créer un jeu sur excel de type A1 donne un nombre entre 11 et 99, A2 la même chose et dans A3 entrer le résultat, puis A4 dit si c'est bon ou faux.
je connais la fonction ALEA mais malheureusement l'entrée dans une autre case d'un nombre puis d'enter change les donnée des cases ALEA 


<config>Windows 7

Kino76 · Answer

Voila le Jeux Fait de 0 a 99 il faudra trouver our mettre de 11 a 99 
Je te transmet également une version qui demande si l'on veut rejouer ou non

Sub JeuxCalcul()
Dim MyValue As Integer
Dim Result As Integer

Range("A1").Select
Randomize
        MyValue = Int(99 * Rnd)
        ActiveCell = MyValue
Range("A2").Select
Randomize
        MyValue = Int(99 * Rnd)
        ActiveCell = MyValue
Range("A3").Select
ActiveCell = InputBox("Quel est le résultat ? ")
Result = Range("A1").Value + Range("A2").Value
If (Range("A3").Value = Result) Then
    Range("A4") = "Correct"
Else
    Range("A4").Value = "Faux"
End If

End Sub

Kino76 · Answer

et voila la version "rejouer"

Sub JeuxCalcul()
Dim MyValue As Integer
Dim Result As Integer
Dim Demande As String

Range("A1").Select
Randomize
        MyValue = Int(99 * Rnd)
        ActiveCell = MyValue
Range("A2").Select
Randomize
        MyValue = Int(99 * Rnd)
        ActiveCell = MyValue
Range("A3").Select
ActiveCell = InputBox("Quel est le résultat ? ")
Result = Range("A1").Value + Range("A2").Value
If (Range("A3").Value = Result) Then
    Range("A4") = "Correct"
Else
    Range("A4").Value = "Faux"
End If
Demande = InputBox("Voulez Vous Rejouez ? ")
If (Demande = "oui") Then
    Call Reset
    Call JeuxCalcul
Else
    Exit Sub
End If
End Sub

Sub Reset()
Dim Ligne As Integer
Dim Colonne As Integer
Ligne = 1
Colonne = 1
Cells(Ligne, Colonne).Select
Do While Not IsEmpty(ActiveCell)
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Clear
        ActiveCell.Offset(1, 0).Select
    Loop
    Colonne = Colonne + 1
    Cells(Ligne, Colonne).Select
Loop
End Sub

voila voila si tu a d'autre questions n'hésite pas

Paf · Answer

Bonsoir
juste deux modifications :

la première pour qu'il n'y ait pas besoin de saisir la réponse et changement de nom de la procédure d'effacement:
....
Demande = MsgBox("Voulez Vous Rejouez ? ", vbYesNo)
If Demande = vbYes Then
Call efface
.....
la deuxième : la procédure pour effacer les 4 cellules utilisées.( on ne peut pas utiliser le nom Reset qui est un nom de méthode VBA...)
Sub efface()
For i = 1 To 4
Range("A" & i).ClearContents
Next
End Sub

bonne suite

Jeu calcul

3 réponses

Discussions similaires

Newsletters