Mettre une condition sur des cellules aléatoires [VBA]

Le 15/11/2016 à 23:28

Bonjour, j'apprends VBA et pour m’entraîner je créer un petit jeu (il est nul mais c'est pour l'entrainement ^^). C'est une sorte de labyrinthe ou des mur apparaissent de façon aléatoire sur la zone de jeux et toutes les 3 secondes le nombre de mur double. Les murs sont représentez par des case qui se remplissent en bleu.

Mon problème c'est que lorsque je déplace le "pion", si il arrive sur une des cases censée être un mur, je n'arrive pas a afficher une message box pour dire "vous avez perdu".

Sub timer()

Application.OnTime Now + TimeSerial(0, 0, 3), "timer"

If lvl = 1 Then
    For i = 0 To 3
        Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Interior.Color = RGB(0, 0, 255)
    Next i
ElseIf lvl = 2 Then
    For i = 0 To 10
        Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Interior.Color = RGB(0, 0, 255)
    Next i
ElseIf lvl = 3 Then
    For i = 0 To 20
        Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Interior.Color = RGB(0, 0, 255)
    Next i
End If

If ActiveCell.Address = Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Address Then
    MsgBox ("perdu tu as touché un mur")
    Application.OnTime Now + TimeSerial(0, 0, 3), "timer", , False
    Call jouer
End If

If Range("arrivé").Address = ActiveCell.Address Then
    Application.OnTime Now + TimeSerial(0, 0, 3), "timer", , False
End If

End Sub

c'est la partie de mon code qui génère les murs. J'ai testé

If ActiveCell.Address = Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Address Then
    MsgBox ("perdu tu as touché un mur")
    Application.OnTime Now + TimeSerial(0, 0, 3), "timer", , False
    Call jouer
End If

pour faire ça mais ça ne fonctionne pas, je pense que c'est parce que les cases sont aléatoire donc il n'y a qu'une adresse qui change toute les 3 secondes du coup. (call jouer renvoie renvoie à ma procédure qui recommence le jeux)

Avez vous une solution?

Merci beaucoup

Le 16/11/2016 à 06:49

Bonjour,

Pour tester, il nous manque la proc "jouer" !

Le 16/11/2016 à 18:06

voici mon code en entier

Dim lvl As Integer

Sub clique_droit()

ActiveCell.Offset(0, 1).Activate
ActiveCell.Interior.Color = RGB(0, 0, 0)
ActiveCell.Offset(0, -1).Interior.Color = RGB(255, 0, 0)

For i = 0 To 13
    If Range("Départ").Offset(i, 10).Address = ActiveCell.Address Then
        MsgBox ("Tu as dépassé les limites")
        Call jouer
    End If
Next i

If Range("arrivé").Address = ActiveCell.Address Then
    MsgBox ("bien joué tu as gagné")
    'Application.OnTime Now + TimeSerial(0, 0, 3), "timer", , False
End If
End Sub

Sub clique_gauche()

ActiveCell.Offset(0, -1).Activate
ActiveCell.Interior.Color = RGB(0, 0, 0)
ActiveCell.Offset(0, 1).Interior.Color = RGB(255, 0, 0)

For i = 0 To 13
    If Range("Départ").Offset(i, -1).Address = ActiveCell.Address Then
        MsgBox ("Tu as dépassé les limites")
        Call jouer
    End If
Next i

End Sub

Sub clique_haut()

ActiveCell.Offset(-1, 0).Activate
ActiveCell.Interior.Color = RGB(0, 0, 0)
ActiveCell.Offset(1, 0).Interior.Color = RGB(255, 0, 0)

For i = 0 To 13
    If Range("Départ").Offset(-1, i).Address = ActiveCell.Address Then
        MsgBox ("Tu as dépassé les limites")
        Call jouer
    End If
Next i

End Sub

Sub clique_bas()

ActiveCell.Offset(1, 0).Activate
ActiveCell.Interior.Color = RGB(0, 0, 0)
ActiveCell.Offset(-1, 0).Interior.Color = RGB(255, 0, 0)

For i = 0 To 13
    If Range("Départ").Offset(29, i).Address = ActiveCell.Address Then
        MsgBox ("Tu as dépassé les limites")
        Call jouer
    End If
Next i

If Range("arrivé").Address = ActiveCell.Address Then
    MsgBox ("bien joué tu as gagné")
    'Application.OnTime Now + TimeSerial(0, 0, 3), "timer", , False
End If

End Sub

Sub jouer()

Range("Départ:arrivé").Interior.ColorIndex = xlColorIndexNone
Range("Départ").Select
Range("Départ").Interior.Color = RGB(0, 0, 0)
Range("arrivé").Interior.Color = RGB(255, 0, 255)
Range("C2:C32").Interior.Color = RGB(0, 0, 255)
Range("N2:N32").Interior.Color = RGB(0, 0, 255)
Range("C2:N2").Interior.Color = RGB(0, 0, 255)
Range("C32:N32").Interior.Color = RGB(0, 0, 255)

Randomize

lvl = InputBox("Choisi ton niveau (entre le chiffre" & Chr(10) & "1- novice" & Chr(10) & "2-J'ai un bon niveau Papa" & Chr(10) & "3-Envoie le niveau master")

Call timer

End Sub

Sub timer()

Application.OnTime Now + TimeSerial(0, 0, 3), "timer"

If lvl = 1 Then
    For i = 0 To 3
        Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Interior.Color = RGB(0, 0, 255)
    Next i
ElseIf lvl = 2 Then
    For i = 0 To 10
        Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Interior.Color = RGB(0, 0, 255)
    Next i
ElseIf lvl = 3 Then
    For i = 0 To 20
        Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Interior.Color = RGB(0, 0, 255)
    Next i
End If

If ActiveCell.Address = Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Address Then
    MsgBox ("perdu tu as touché un mur")
    Application.OnTime Now + TimeSerial(0, 0, 3), "timer", , False
    Call jouer
End If

If Range("arrivé").Address = ActiveCell.Address Then
    Application.OnTime Now + TimeSerial(0, 0, 3), "timer", , False
End If

End Sub

si vous avez des remarques sur l'optimisation du code je prends aussi ^^. Pour les sub click droit ... ils ont un bouton en forme de flèche associé. J'ai joinds le fichier excel aussi. Autre question, au lieux de passer par des bouton pour gérer les directions, est il possible de le faire directement au clavier?

Merci de votre aide

6jeux-du-labyrinthe.xlsm (28.74 Ko)
Le 17/11/2016 à 14:36

Voici le code complet, un amis m'a aidé à trouver la solution

Dim lvl As Integer

Sub clique_droit() 'gère le déplacement à droite

Call murgameover("droite")

ActiveCell.Offset(0, 1).Activate 'la case active se déplace à droite
ActiveCell.Interior.Color = RGB(0, 0, 0) 'couleur de fond de la case est noire
ActiveCell.Offset(0, -1).Interior.Color = RGB(255, 0, 0) 'la couleur a gauche de la caseactive devient rouge

For i = 0 To 13 'limite le terrain à droite
    If Range("Départ").Offset(i, 10).Address = ActiveCell.Address Then
        MsgBox ("Tu as dépassé les limites")
        Call jouer 'le jeu recommence
    End If
Next i

If Range("arrivé").Address = ActiveCell.Address Then 'quand on arrive sur la case gagné
    MsgBox ("bien joué tu as gagné")
End If
End Sub

Sub clique_gauche()

Call murgameover("gauche")

ActiveCell.Offset(0, -1).Activate ''la case active se déplace à gauche
ActiveCell.Interior.Color = RGB(0, 0, 0)
ActiveCell.Offset(0, 1).Interior.Color = RGB(255, 0, 0) 'la couleur a droite de la caseactive devient rouge

For i = 0 To 13 'limite le terrain à gauche
    If Range("Départ").Offset(i, -1).Address = ActiveCell.Address Then
        MsgBox ("Tu as dépassé les limites")
        Call jouer
    End If
Next i

End Sub

Sub clique_haut()

murgameover ("haut")

ActiveCell.Offset(-1, 0).Activate
ActiveCell.Interior.Color = RGB(0, 0, 0)
ActiveCell.Offset(1, 0).Interior.Color = RGB(255, 0, 0)

For i = 0 To 13
    If Range("Départ").Offset(-1, i).Address = ActiveCell.Address Then
        MsgBox ("Tu as dépassé les limites")
        Call jouer
    End If
Next i

End Sub

Sub clique_bas()

Call murgameover("bas")

ActiveCell.Offset(1, 0).Activate
ActiveCell.Interior.Color = RGB(0, 0, 0)
ActiveCell.Offset(-1, 0).Interior.Color = RGB(255, 0, 0)

For i = 0 To 13
    If Range("Départ").Offset(29, i).Address = ActiveCell.Address Then
        MsgBox ("Tu as dépassé les limites")
        Call jouer
    End If
Next i

If Range("arrivé").Address = ActiveCell.Address Then
    MsgBox ("bien joué tu as gagné")
End If

End Sub

Sub jouer()

Range("Départ:arrivé").Interior.ColorIndex = xlColorIndexNone 'on efface toute les couleur du plateau de jeu
Range("Départ").Select 'on selection la case départ
Range("Départ").Interior.Color = RGB(0, 0, 0)
Range("arrivé").Interior.Color = RGB(255, 0, 255)
Range("C2:C32").Interior.Color = RGB(0, 0, 255)
Range("N2:N32").Interior.Color = RGB(0, 0, 255)
Range("C2:N2").Interior.Color = RGB(0, 0, 255)
Range("C32:N32").Interior.Color = RGB(0, 0, 255)

'cette input box sert à choisir le niveau
lvl = InputBox("Choisi ton niveau (entre le chiffre" & Chr(10) & "1- novice" & Chr(10) & "2-J'ai un bon niveau Papa" & Chr(10) & "3-Envoie le niveau master je ne suis pas un PD")

Call timer

End Sub

Sub timer() 'onaffiche les mur de façon aléatoire et ils doublent toutes les 3 secondes

Application.OnTime Now + TimeSerial(0, 0, 3), "timer" 'ça sert à lancer cetteprocédure toute les 3 seconde
'l'application ontim permet de choisir un horairepour lancer la procédure
'on lance la procédure à partir de maintenant + 3 seconde puis on appelle la procedure à lance donc ,"timer"

Randomize 'c'est pour avoir un aléatoire qui change à chaquefois qu'on ouvre le classeur
'on fait une boucle pour faire apparaitre le nombre de mur en fonction du niveau choisi
If lvl = 1 Then
    For i = 0 To 3
        Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Interior.Color = RGB(0, 0, 255)
    Next i
ElseIf lvl = 2 Then
    For i = 0 To 10
        Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Interior.Color = RGB(0, 0, 255)
    Next i
ElseIf lvl = 3 Then
    For i = 0 To 20
        Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Interior.Color = RGB(0, 0, 255)
    Next i
End If

If Range("arrivé").Address = ActiveCell.Address Then
    Application.OnTime Now + TimeSerial(0, 0, 3), "timer", , False 'cette condition stop l'apparition des mur carsans ça maisapprès avoirfini le jeux lesmur continueraient d'apparaitre
End If

End Sub

Sub murgameover(direction) 'on regarde si dans la direction qu'on veut la case est bleue ou pas

Select Case direction
Case "droite"
    If ActiveCell.Offset(0, 1).Interior.Color = RGB(0, 0, 255) Then
        MsgBox ("tu as explosé sur un mur")
        ActiveCell.Offset(0, -1).Select 'on doit mettre cette ligne pour faire un mouvement à gauche car sub click_droit() fini de s'exécuter et fait unmouvement à droite, ici onannule ce mouvement
    End If
Case "gauche"
    If ActiveCell.Offset(0, -1).Interior.Color = RGB(0, 0, 255) Then
        MsgBox ("tu as explosé sur un mur")
        ActiveCell.Offset(0, 1).Select
    End If
Case "bas"
    If ActiveCell.Offset(1, 0).Interior.Color = RGB(0, 0, 255) Then
        MsgBox ("tu as explosé sur un mur")
        ActiveCell.Offset(-1, 0).Select
    End If
Case "haut"
    If ActiveCell.Offset(-1, 0).Interior.Color = RGB(0, 0, 255) Then
        MsgBox ("tu as explosé sur un mur")
        ActiveCell.Offset(1, 0).Select
    End If
End Select

End Sub
Le 17/11/2016 à 15:52

Bonjour,

Tu peux tester ce code si tu veux. Mets le tien en commentaire et colles ce qui suit dans le module puis testes :

Option Explicit

Dim lvl As Integer
Dim Cel As Range
Dim Fin As Boolean

Sub clique_droit()

    ActiveCell.Offset(0, 1).Select
    Controle
    Colorer

End Sub

Sub clique_gauche()

    ActiveCell.Offset(0, -1).Select
    Controle
    Colorer

End Sub

Sub clique_haut()

    ActiveCell.Offset(-1).Select
    Controle
    Colorer

End Sub

Sub clique_bas()

    ActiveCell.Offset(1).Select
    Controle
    Colorer

End Sub

Sub Controle()

    'On Error Resume Next

    If Intersect(ActiveCell, Range("D3:M31")) Is Nothing = True Then

        MsgBox "Tu as dépassé les limites !"
        Fin = True
        Exit Sub

    End If

    If ActiveCell.Interior.Color = RGB(0, 0, 255) Then

        MsgBox "Un mur !" & vbCrLf & vbCrLf & "Tu as perdu !"
        Fin = True

    End If

    If Range("arrivé").Address = ActiveCell.Address Then

        MsgBox ("bien joué tu as gagné !")
        Fin = True

    End If

End Sub

Sub Colorer()

    Cel.Interior.Color = RGB(255, 0, 0)
    Set Cel = ActiveCell
    Cel.Interior.Color = RGB(0, 0, 0)

End Sub

Sub jouer()

    Dim Retour

    Fin = True

    Range("Départ:arrivé").Interior.ColorIndex = xlColorIndexNone
    Range("Départ").Select
    Range("Départ").Interior.Color = RGB(0, 0, 0)
    Range("arrivé").Interior.Color = RGB(255, 0, 255)
    Range("C2:C32").Interior.Color = RGB(0, 0, 255)
    Range("N2:N32").Interior.Color = RGB(0, 0, 255)
    Range("C2:N2").Interior.Color = RGB(0, 0, 255)
    Range("C32:N32").Interior.Color = RGB(0, 0, 255)

    Randomize

    Retour = InputBox("Choisi ton niveau (entre le chiffre" & Chr(10) & "1 - novice" & _
                      Chr(10) & _
                      "2 - J'ai un bon niveau Papa" & _
                      Chr(10) & _
                      "3 - Envoie le niveau master je ne suis pas un PD")

    If IsNumeric(Retour) Then

        lvl = CInt(Retour)

        If lvl < 1 Or lvl > 3 Then

            MsgBox "Le choix doit être 1, 2 ou 3 !"
            Exit Sub

        End If

        Set Cel = Range("Départ")

    Else

        MsgBox "Seulement 1, 2 ou 3 !"
        Exit Sub

    End If

    Fin = False

    Call timer

End Sub

Sub timer()

    Dim I As Integer

    If Fin = True Then Exit Sub

    Application.OnTime Now + TimeSerial(0, 0, 3), "timer"

    For I = 0 To Choose(lvl, 3, 10, 20)
        Cells(Int(28 * Rnd) + 3, Int(10 * Rnd) + 4).Interior.Color = RGB(0, 0, 255)
    Next I

End Sub
Rechercher des sujets similaires à "mettre condition aleatoires vba"