Voici la base que tu pourrais suivre
Mon chère Clementale,
Voici un code que j'ai fait en quelques secondes... J'espère que ça conviendra à ton niveau
Code:
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
130
131
132
133
134
135
136
137
| Public Tirage1 As Integer
Public ValeurObtenue As Integer
Public ValeurActuelle As Integer
Public Sub LancerDe()
Tirage1 = Int((6 * Rnd) + 1) + Int((6 * Rnd) + 1)
'Tirage1 = 1
Call DeplacerPion
Call MessageTirage
End Sub
Public Sub MessageTirage()
Dim Titre As String
Titre = "Tirage du Dé"
Select Case Tirage1
Case 2 To 12
MsgBox "Vous avancez de : " & Tirage1 & " Cases", , Titre
End Select
End Sub
Public Sub NouvellePartie()
Range("A2:J9").Select
Selection.Interior.ColorIndex = xlNone
Range("A2").Select
Selection.Interior.ColorIndex = 3
End Sub
Public Sub DeplacerPion()
ValeurActuelle = ActiveCell.Value
ValeurObtenue = ValeurActuelle + Tirage1
ValeurRecherchee = ValeurActuelle + 1
Select Case ValeurObtenue
Case Is < 73
Do While ValeurRecherchee < ValeurObtenue
Range("A2:J9").Select
Selection.Find(What:=ValeurRecherchee, After:=ActiveCell, MatchCase:=True).Select
ActiveCell.Interior.ColorIndex = 15
ValeurRecherchee = ValeurRecherchee + 1
Loop
Range("A2:J9").Select
Selection.Find(What:=ValeurObtenue, After:=ActiveCell, MatchCase:=True).Select
ActiveCell.Interior.ColorIndex = 16
Case Is > 73
MsgBox "Vous devez rejouer pour tomber PILE sur 73 "
Case Is = 73
Range("A2:J9").Select
Do While ValeurRecherchee <= ValeurObtenue
Range("A2:J9").Select
Selection.Find(What:=ValeurRecherchee, After:=ActiveCell, MatchCase:=True).Select
ActiveCell.Interior.ColorIndex = 5
ValeurRecherchee = ValeurRecherchee + 1
Loop
Selection.Find(What:=ValeurObtenue, After:=ActiveCell, MatchCase:=True).Select
ActiveCell.Interior.ColorIndex = 5
MsgBox "Bravo, vous gagnez la partie"
End Select
End Sub
Option Explicit
Dim Joueurs(6) As New Joueur
Dim Plateau(73) As New Kase
Dim Bonus(12) As New BonusMalus
Dim Malus(4) As New BonusMalus
Dim i As Integer
Public Sub Init()
' initialise le plateau
Const Affectecase = "A1B1C1D1E1F1G1H1H2G2F2E2D2C2B2A2A3B3C3D3E3F3G3H3H4G4F4E4D4C4B4A4A5B5C5D5E5F5G5H5H6G6F6E6D6C6B6A6A7B7C7D7E7F7G7H7H8G8F8E8D8C8B8A8A9B9C9D9E9F9G9H9"
For i = 1 To 72
Plateau(i).Cellule = Mid(Affectecase, i * 2 - 1, 2)
ActiveSheet.Range(Mid(Affectecase, i * 2 - 1, 2)) = i
Next
' initialise les bonus
Bonus(1).Nom = "Boast"
Bonus(1).Déplus = 1
Bonus(2).Nom = "Replay"
Bonus(2).Rejouer = True
Bonus(3).Nom = "Invulnerable"
Bonus(3).Invulnerable = True
Bonus(4).Nom = "Bouclier"
Bonus(4).Reduit = 1
Bonus(5).Nom = "Armure"
Bonus(5).Reduit = 2
Bonus(6).Nom = "Reparation"
Bonus(6).Pvplus = 1
Bonus(7).Nom = "Mine"
Bonus(7).Pvmoins = 2
Bonus(8).Nom = "Frappe Aérienne"
Bonus(8).Pvmoins = 3 '?????????????????????????????????
Bonus(9).Nom = "Nova"
Bonus(9).Pvmoins = 2
Bonus(10).Nom = "Pistolet"
Bonus(10).Pvmoins = 1
Bonus(11).Nom = "Fusil"
Bonus(11).Pvmoins = 2
Bonus(12).Nom = "Canon"
Bonus(12).Pvmoins = 3
Malus(1).Nom = "Mines"
Malus(1).Pvmoins = 2
Malus(2).Nom = "Trous"
Malus(2).Bloque = True
Malus(3).Nom = "Sable"
Malus(3).Divise = 2
Malus(4).Nom = "Eau"
Malus(4).Divise = 3
End Sub
Public Function Jettedé()
Jettedé = Int(6 * Rnd) + 1
End Function
Public Function ordre()
' initialise les joueurs
Dim Nbjoueurs As Integer
Nbjoueurs = InputBox("Combien de joueurs (1 à 6)")
ActiveSheet.Range("K1") = Nbjoueurs
Dim i As Integer
Dim tmpnom As String
Dim cell As String
For i = 1 To Nbjoueurs
tmpnom = InputBox("Nom du joueur " & i & "?")
Joueurs(i).Nom = tmpnom
Joueurs(i).Vies = 6
ActiveSheet.Range("K" & (i + 1)) = tmpnom
ActiveSheet.Range("L" & (i + 1)) = Joueurs(i).Vies
Next
End Function |
Au plaisir, féru de VBA
