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
| Option Explicit
Private Const N As Byte = 8 'Damier 8x8
Private Enum DIRECTION
Haut
Gauche
Droite
Bas
End Enum
Private Type PION
Pos As Byte
Dir As DIRECTION
End Type
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static Joueur As Boolean
If Not Intersect(Target, Range("A1").Resize(N, N)) Is Nothing Then
If Target.Count = 1 Then
If Target = "" Then
Joueur = Not Joueur
Target = 1 + Abs(Joueur)
Check Target
End If
End If
End If
End Sub
Private Function LesVoisins(ByVal M As Integer) As PION()
Dim Tb() As PION
Dim P As Byte
If M - N > 0 Then
P = P + 1
ReDim Tb(1 To P)
Tb(P).Pos = M - N
Tb(P).Dir = Haut
End If
If M Mod N <> 1 Then
P = P + 1
ReDim Preserve Tb(1 To P)
Tb(P).Pos = M - 1
Tb(P).Dir = Gauche
End If
If M Mod N <> 0 Then
P = P + 1
ReDim Preserve Tb(1 To P)
Tb(P).Pos = M + 1
Tb(P).Dir = Droite
End If
If M + N < N * N Then
P = P + 1
ReDim Preserve Tb(1 To P)
Tb(P).Pos = M + N
Tb(P).Dir = Bas
End If
LesVoisins = Tb
End Function
Private Sub Check(ByVal v As Range)
Dim i As Byte, j As Byte, k As Byte
Dim T1() As PION, T2() As PION
Dim c As Range
Set c = Range("A1").Resize(N, N)
For i = 1 To N * N
If c(i).Address = v.Address Then Exit For
Next i
T1 = LesVoisins(i)
For j = 1 To UBound(T1)
If c(T1(j).Pos) * c(i) = 2 Then
T2 = LesVoisins(T1(j).Pos)
For k = 1 To UBound(T2)
If c(T2(k).Pos) * c(T1(j).Pos) = 2 And T2(k).Dir = T1(j).Dir Then
c(T1(j).Pos) = c(i)
Exit For
End If
Next k
End If
Next j
If Application.Count(c) = N * N Then MsgBox "Partie terminée"
Set c = Nothing
End Sub
Private Sub RAZ_Click()
Dim a As Byte, b As Byte
Dim c As Range
Set c = Range("A1").Resize(N, N)
c.ClearContents
Randomize
a = IIf(Rnd() < 0.5, 1, 2)
b = IIf(a = 1, 2, 1)
c(4, 4) = a
c(4, 5) = b
c(5, 4) = b
c(5, 5) = a
c.Select
Set c = Nothing
End Sub |
