Ma macro/VBA fait planter Excel

Le 17/05/2015 à 17:43

Bonjour à tous,

Voilà j'ai un petit problème urgent (sur un projet à rendre ce soir), j'ai une macro qui fait planter excel alors que normalement elle fonctionne très bien .. la première fois elle marche et la seconde elle plante..

voici la macro qui bug

Sub vendre_1_foie()

Call actu

If Canard_c <= 0 Then
    MsgBox "tu n'as pas de canard à vendre"
    Exit Sub
End If

M = 0
K = Round(Rnd() * (P - 1)) + 1
For I = 1 To Enclos_c
    For J = 1 To 20
        M = M + 1
        If K = M Then
            If ferme(I).terrain(J).existence = True Then
                ferme(I).terrain(J).existence = False
           Else
                K = K + 1
                'MsgBox K'débogage
                If K > P Then
                    K = 1
                    J = 0
                    I = 1
                    M = 0
                    'MsgBox "passage"'débogage
                End If
            End If
           End If
    Next
Next

Argent = Argent + 1,5#
Canard_c = Canard_c - 1

Call actu

End Sub

voici le code complet (dans un module)

    Dim Argent As Double
    Dim Mois As Byte
    Dim Mais As Integer
    Dim Compteur_m As Integer
    Dim Compteur_f As Integer
    Dim Nb_couple As Integer
    Dim Nb_naissance As Integer
    Dim Naissance_s As Integer
    Dim Canard_c As Integer
    Dim Enclos_c As Byte
    Dim Nais As Integer
    Dim Sexe As Byte
    Dim Mort_v As Integer

Sub initialisation()

Mois = 0
Mais = 20
Argent = 0
Compteur = 0
Enclos_c = 1
Canard_c = 0

For b = 1 To 20
    ferme(1).terrain(b).existence = False
Next b

ferme(1).terrain(1).Sexe = True
ferme(1).terrain(1).age = 1
ferme(1).terrain(1).existence = True

ferme(1).terrain(2).Sexe = False
ferme(1).terrain(2).age = 1
ferme(1).terrain(2).existence = True

For V = 1 To 20
    If ferme(1).terrain(V).existence = True Then
    Canard_c = Canard_c + 1
    End If
Next V

Call actu

End Sub
Sub passer_mois()

Call actu

'tuer les canards trop vieux
Mort_v = 0
For w = 1 To 20
    If ferme(1).terrain(w).age > 6 Then
    ferme(1).terrain(K).existence = False
    Mort_v = Mort_v + 1
    End If
Next w
If Mort_v <> 0 Then
MsgBox Mort_v & " canard sont morts de veilliesse"
End If

Call actu

If Canard_c > Mais Then
   MsgBox "Vous n'avez pas nourris tous vos canards, vous devez acheter de la nourriture"
   Exit Sub
End If

Mais = Mais - Canard_c

Call actu

'tuer des canards aléatoirement
If Mois <> 0 Then
    For N = 1 To Enclos_c
    Randomize
        Maladie = Int(15 * Rnd) + 1 'choix du nombre de futur malade
        If Maladie > 10 Then
            Maladie = Maladie - 10 'maladie = nb de malades
            For c = 0 To Maladie 'pour chaque malade potentiel
                Randomize
                x = Int(19 * Rnd) + 1 'on choisi aléatoirement le malade
                ferme(N).terrain(x).existence = False 'on tue le malade
            Next c
        End If
    Next N
End If
Call actu

'faire grandir les canard
For s = 1 To Enclos_c
    For l = 1 To 20
        If ferme(s).terrain(l).existence = True Then
        ferme(s).terrain(l).age = age + 1
        End If
    Next l
Next s

Call reprod

Mois = Mois + 1
If Mois > 12 Then
MsgBox "Victoire!! Tu as gagné!! Cela fait un an déjà. Tu as gagné " & Argent & "€ !!!"
Call initialisation
End If

Call actu

End Sub

Sub acheter_mais()

Mais = Mais + 20
Argent = Argent - 10

Call actu

End Sub

Sub acheter_200_mais()

Mais = Mais + 200
Argent = Argent - 100

Call actu

End Sub

Sub acheter_2000_mais()

Mais = Mais + 2000
Argent = Argent - 1000

Call actu

End Sub

Sub vendre()

Argent = Argent + 1,5

'supprimer un canard

Call actu

End Sub

Sub reprod()

Call actu

If Compteur_m < Compteur_f Then
    Nb_couple = Compteur_m
Else
    Nb_couple = Compteur_f
End If

Nais = 0

If Nb_couple > 0 Then
    For J = 1 To Nb_couple
        Nais = Nais + (Round(5 * Rnd()) + 5)
    Next
End If

If Nb_couple = 0 Then
    Exit Sub
End If

If (Canard_c + Nais) > (Enclos_c * 20) Then
    Nais = Enclos_c * 20 - Canard_c
    MsgBox "Les champs sont pleins " & Nais & " canards sont nés"
End If

For J = 1 To Enclos_c
    For I = 1 To 20
        If ferme(J).terrain(I).existence = False Then

            ferme(J).terrain(I).existence = True
            ferme(J).terrain(I).age = 0
            Sexe = Round(1 + Rnd())
            If Sexe = 1 Then
            ferme(J).terrain(I).Sexe = True
            Else
            ferme(J).terrain(I).Sexe = False
            End If

            Nais = Nais - 1
            If Nais <= 0 Then
                Exit For
            End If
        End If
    Next
    If Nais <= 0 Then
        Exit For
    End If
Next

Call actu

End Sub

Sub achat_enclos()

Enclos_c = Enclos_c + 1
Argent = Argent - 30

    For V = 1 To 20
        ferme(Enclos_c).terrain(V).existence = False
    Next V

Call actu

End Sub

Sub achat_10_enclos()

Call actu

c = Enclos_c + 1
For b = c To Enclos_c + 10
    For V = 1 To 20
        ferme(c).terrain(V).existence = False
    Next V
Next b

Enclos_c = Enclos_c + 10
Argent = Argent - 300

Call actu

End Sub

Sub achat_20_enclos()

Call actu

c = Enclos_c + 1
For b = c To Enclos_c + 20
    For V = 1 To 20
        ferme(c).terrain(V).existence = False
    Next V
Next b

Enclos_c = Enclos_c + 20
Argent = Argent - 600

Call actu

End Sub

Sub vendre_1_foie()

Call actu

If Canard_c <= 0 Then
    MsgBox "tu n'as pas de canard à vendre"
    Exit Sub
End If

M = 0
K = Round(Rnd() * (P - 1)) + 1
For I = 1 To Enclos_c
    For J = 1 To 20
        M = M + 1
        If K = M Then
            If ferme(I).terrain(J).existence = True Then
                ferme(I).terrain(J).existence = False
           Else
                K = K + 1
                'MsgBox K'débogage
                If K > P Then
                    K = 1
                    J = 0
                    I = 1
                    M = 0
                    'MsgBox "passage"'débogage
                End If
            End If
           End If
    Next
Next

Argent = Argent + 1,5#
Canard_c = Canard_c - 1

Call actu

End Sub

Sub actu()

Canard_c = 0
Compteur_m = 0
Compteur_f = 0
For b = 1 To Enclos_c
    For V = 1 To 20
        If ferme(b).terrain(V).existence = True Then
            Canard_c = Canard_c + 1
            If ferme(b).terrain(V).Sexe = True Then
                Compteur_m = Compteur_m + 1
            End If
            If ferme(b).terrain(V).Sexe = False Then
                Compteur_f = Compteur_f + 1
            End If
        End If
    Next V
Next b

   Cells(8, 2).Value = Canard_c
   Cells(9, 2).Value = Argent
   Cells(10, 2).Value = Mois
   Cells(11, 2).Value = Mais
   Cells(12, 2).Value = Enclos_c
   Cells(7, 2).Value = Compteur_f
   Cells(6, 2).Value = Compteur_m
End Sub

et voici le 2nd module

Type Canard
age As Byte
existence As Boolean
Sexe As Boolean 'true = male
End Type

Type enclos
terrain(1 To 20) As Canard
End Type

Public ferme(1 To 255) As enclos

Voila est ce quelqu'un pourrais me dire ce qui va pas SVP ?

Cordialement

Baldo

18guppys.xlsm (38.95 Ko)
Le 17/05/2015 à 18:03

Bonsoir,

Tout d'abord, je pense que le plus urgent, c'est ceci, notamment le point 3.

Ensuite, demande une réponse urgente, sur un jeu....(surtout un dimanche)

A moins que tu ne soies rétribué...

Auquel cas, pourquoi faire appel à des bénévoles...

Et enfin, tu utilises des déclarations personnalisées de variables, un code long comme une journée sans pain, sans explication de ce qu'il doit faire (ni de ce qu'on gagne à la fin....), bref, revois la notion d'urgence...

Et explique un peu plus les règles de ton jeu, afin qu'on puisse appréhender au mieux le problème.

Bonne fin de W-E

Le 17/05/2015 à 18:24

Merci de la réponse,

En fait je suis école d'ingé et c'est un projet que je dois rendre ce soir (via un serveur )..

Je vous ai mis en fichier joint les règles..

25elevage-de-guppys.pdf (52.53 Ko)
Le 17/05/2015 à 18:39

Re-,

Je ne vais pas rentrer dans quelque polémique que ce soit....

S'affoler quelques heures avant l'échéance....

Bon courage (et je ne suis pas ingénieur, loin de là....)

Rechercher des sujets similaires à "macro vba fait planter"