Bonjour,

J'ai créé un modeste petit jeu d'enchères, celui ci fonctionne tel qu'il est supposé fonctionner
l'utilisateur dispose de 3 actions possibles, Egaler, Monter ou PAsser qu'il actionne au moyen de petits contrôles
afin de faciliter la tâche j'ai voulu mettre des raccourcis simples sans combinaison de touches sur les macros associées et donc déclencher ces macros sur appui des touches respectivement E, M et P... ça a l'air de fonctionne sauf que de temps en temps, le programme s'arrête comme si il y avait une sorte de End suite à l'appui d'une touche et je ne comprends pas pourquoi

en fait ça semble s'arrêter quand je suis dans une cellule sélectionnée et que j'écris une lettre n'importe laquelle ça agit comme un End alors que si par contre je suis pas focus dans une cellule là ça passe

Si vous avez une idée

test_ench_dvp.xlsm

merci bcp
Gorz


ANNEXE pour ceux qui veulent pas activer les macros je sais qu'il y en a voici la totalité du code VBA derrière

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
Declare Function GetAsyncKeyState Lib "User32" (ByVal vKey As Long) As Integer
Public monte
Public bouge
Sub lancer_enchère()
For Each cell0 In Range("stratégiedechacun")
cell0.Value = Int((Rnd() - 0.4) * 4)
Next cell0
Range("vous") = Application.UserName
Range("obj") = Int(Range("nbjoueurs") * 3 * Rnd()) + 2
 
Range("zoneobj").ClearContents
For Each cell0 In Range("zonebrzf")
    cell0.Value = Range("brzf")
Next cell0
 
MsgBox ("L'enchère commence, il y a " & Range("obj") & " objets en jeu")
 
For i = 1 To Range("obj")
    Range("prix") = 0 'initialisation du prix
    Range("monprix") = 0 'initialisation de la mise
    bouge = 1 'utile pour bloquer un cheat
debutench:
    monte = 0 'indicateur d'action manuelle
    ActiveSheet.Calculate 'cycle des enchères automatiques
    While Range("encours") > 0 And Range("enlice") > 1
        Range("prix") = Range("prix") + 1
        ActiveSheet.Calculate
        DoEvents
    Wend
    '--------------- début des enchères manuelles -------------'
    deb = Timer
    While Timer - deb < 5
 
        If GetAsyncKeyState(69) <> 0 Then Call Egaler
        If GetAsyncKeyState(77) <> 0 Then Call Monter
        If GetAsyncKeyState(80) <> 0 Then Call passer
 
        If monte = -1 Then 'le joueur a passé son tour
            deb = Timer - 5 'on accélère la fin de l'enchère
            GoTo finench 'on va à la fin de l'enchère
        End If
        If monte = 1 And bouge = 1 Then GoTo actionmanuelle
        DoEvents
        If Range("prix") > 0 Then 'y a-t-il un preneur ?
            Range("état") = "Objet n°" & i & " pour " & Range("prix") & " jetons à " & Range("joueurs")(Range("gagnant")) & ", " & Format((Timer - deb) / 2, "0") & " fois"
        Else
            Range("état") = "Personne ?"
        End If
    Wend
actionmanuelle:
    If monte = 1 And bouge = 1 Then
        bouge = 0
        GoTo debutench 'si le joueur égalise ou enchérie on recommence au début
    End If
finench:
    If Range("prix") > 0 Then
        While Timer - deb < 7
            Range("état") = "Adjugé vendu pour " & Range("prix") & " jetons à " & Range("joueurs")(Range("gagnant"))
        Wend
        Range("zoneobj")(Range("gagnant")) = Range("zoneobj")(Range("gagnant")) + 1
        Range("zonebrzf")(Range("gagnant")) = Range("zonebrzf")(Range("gagnant")) - Range("prix")
    Else
        While Timer - deb < 7
            Range("état") = "L'objet n'a pas trouvé preneur :'("
        Wend
    End If
 
Next i
 
'---------------   FIN DE PARTIE --------------'
Range("état") = "terminé !"
malig = Sheets("Historiq").Cells(1, 1)
Sheets("Historiq").Cells(1, 1) = malig + 1
Sheets("Historiq").Cells(malig, 3) = Range("obj") 'nombre d'objets
Sheets("Historiq").Cells(malig, 1) = Application.UserName
ActiveSheet.Calculate
If Range("supergagné") Then
    Sheets("Historiq").Cells(malig, 2) = "supergagnant"
    MsgBox "Bravo vous êtes vraiment le meilleur de tous"
Else
    If Range("gagné") Then
        Sheets("Historiq").Cells(malig, 2) = "gagnant"
        MsgBox "Bravo vous avez réussi à être le meilleur ex aequo"
    ElseIf Range("loose") Then
        Sheets("Historiq").Cells(malig, 2) = "loose"
        MsgBox "Vous avez échoué lamentablement à avoir un maximum d'objets"
    ElseIf Range("superloose") Then
        Sheets("Historiq").Cells(malig, 2) = "superloose"
        MsgBox "ah non mais là c'est vraiment très mauvais !"
    Else
        MsgBox "perdant"
        MsgBox "bon t'as perdu, étrange non?"
    End If
End If
 
 
End Sub
Sub Monter()
If Range("monbrzf") <= Range("prix") Then
    MsgBox "tu n'es pas solvable mon ami..."
    Range("monprix") = 0
Else
    monte = 1
    bouge = 1
    Range("monprix") = Range("prix") + 1
    Range("état") = Application.UserName & " a surenchéri à " & Range("monprix") + 1 & " jetons !"
End If
 
End Sub
 
Sub Egaler()
If Range("monbrzf") < Range("prix") Then
    MsgBox "c'est la prison qui te guette mon pauvre !"
    Range("monprix") = 0
ElseIf bouge = 1 Then
    monte = 1
    Range("état") = Application.UserName & " propose " & Range("prix") & " jetons également"
    Range("monprix") = Range("prix")
Else
    MsgBox "tu ne peux égaler qu'une fois mon petit"
End If
End Sub
Sub arreter()
Range("état") = "Jeu arrêté"
End
End Sub
Sub passer()
    monte = -1
End Sub