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 |
Partager