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.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
Sub PrepareField()
Sheets("Game").Select
Columns("A:L").Select
Selection.ColumnWidth = 1 . 71
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Sheets("Over").Select
Columns("A:L").Select
Selection.ColumnWidth = 1 . 71
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Application.MacroOptions Macro:="StartGame", Description:="", ShortcutKey:="s"
Application.MacroOptions Macro:="SetMine", Description:="", ShortcutKey:="x"
Application.MacroOptions Macro:="OpenCell", Description:="", ShortcutKey:="d"
End Sub
Sub StartGame()
Dim i, j As Integer
Dim x( 1 To 10 ) As Integer
Dim y( 1 To 10 ) As Integer
Sheets("Game").Select
Range("B2:K11").Value = ""
Range("B2:K11").Select
Selection.Font.ColorIndex = 0
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlDash
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlDash
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Interior
.ColorIndex = 2
.Pattern = xlCrissCross
.PatternColorIndex = 15
End With
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""X"""
With Selection.FormatConditions( 1 ).Font
.Bold = True
.Italic = False
' .ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="99"
With Selection.FormatConditions( 2 ).Font
.Bold = True
.Italic = False
' .ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""#"""
With Selection.FormatConditions( 3 ).Font
.Bold = True
.Italic = False
' .ColorIndex = 3
End With
m1:
Sheets("Over").Select
' Range("M1").Value = "X"
' Range("N1").Value = "Y"
' Range("M2:N11").Value = ""
' Range("M2:N11").Select
' Selection.Interior.ColorIndex = xlNone
Range("B2:K11").Value = 0
Range("B2:K11").Select
Selection.Font.ColorIndex = 0
Selection.Font.Bold = False
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSemiGray75
.PatternColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("C13:J13").Select
Selection.ClearContents
For i = 1 To 10
x(i) = Int(Rnd * 10 ) + 1
y(i) = Int(Rnd * 10 ) + 1
' Range("M" & i + 1).Value = X(i)
' Range("N" & i + 1).Value = Y(i)
For j = i - 1 To 1 Step - 1
If x(i) = x(j) And y(i) = y(j) Then
' Range("M" & i + 1 & ":N" & i + 1).Select
' Selection.Interior.ColorIndex = 15
' Range("M" & j + 1 & ":N" & j + 1).Select
' Selection.Interior.ColorIndex = 15
' MsgBox "Проверка на уникальность не прошла.."
GoTo m1
End If
Next
Cells(x(i) + 1 , y(i) + 1 ).Value = 100
If x(i) > 1 And y(i) > 1 And x(i) < 10 And y(i) < 10 Then
Cells(x(i), y(i)).Value = Cells(x(i), y(i)).Value + 1
Cells(x(i), y(i) + 1 ).Value = Cells(x(i), y(i) + 1 ).Value + 1
Cells(x(i), y(i) + 2 ).Value = Cells(x(i), y(i) + 2 ).Value + 1
Cells(x(i) + 1 , y(i)).Value = Cells(x(i) + 1 , y(i)).Value + 1
Cells(x(i) + 1 , y(i) + 2 ).Value = Cells(x(i) + 1 , y(i) + 2 ).Value + 1
Cells(x(i) + 2 , y(i)).Value = Cells(x(i) + 2 , y(i)).Value + 1
Cells(x(i) + 2 , y(i) + 1 ).Value = Cells(x(i) + 2 , y(i) + 1 ).Value + 1
Cells(x(i) + 2 , y(i) + 2 ).Value = Cells(x(i) + 2 , y(i) + 2 ).Value + 1
End If
If x(i) = 1 And y(i) > 1 And y(i) < 10 Then
Cells(x(i) + 1 , y(i)).Value = Cells(x(i) + 1 , y(i)).Value + 1
Cells(x(i) + 1 , y(i) + 2 ).Value = Cells(x(i) + 1 , y(i) + 2 ).Value + 1
Cells(x(i) + 2 , y(i)).Value = Cells(x(i) + 2 , y(i)).Value + 1
Cells(x(i) + 2 , y(i) + 1 ).Value = Cells(x(i) + 2 , y(i) + 1 ).Value + 1
Cells(x(i) + 2 , y(i) + 2 ).Value = Cells(x(i) + 2 , y(i) + 2 ).Value + 1
End If
If x(i) = 10 And y(i) > 1 And y(i) < 10 Then
Cells(x(i), y(i)).Value = Cells(x(i), y(i)).Value + 1
Cells(x(i), y(i) + 1 ).Value = Cells(x(i), y(i) + 1 ).Value + 1
Cells(x(i), y(i) + 2 ).Value = Cells(x(i), y(i) + 2 ).Value + 1
Cells(x(i) + 1 , y(i)).Value = Cells(x(i) + 1 , y(i)).Value + 1
Cells(x(i) + 1 , y(i) + 2 ).Value = Cells(x(i) + 1 , y(i) + 2 ).Value + 1
End If
If x(i) > 1 And x(i) < 10 And y(i) = 1 Then
Cells(x(i), y(i) + 1 ).Value = Cells(x(i), y(i) + 1 ).Value + 1
Cells(x(i), y(i) + 2 ).Value = Cells(x(i), y(i) + 2 ).Value + 1
Cells(x(i) + 1 , y(i) + 2 ).Value = Cells(x(i) + 1 , y(i) + 2 ).Value + 1
Cells(x(i) + 2 , y(i) + 1 ).Value = Cells(x(i) + 2 , y(i) + 1 ).Value + 1
Cells(x(i) + 2 , y(i) + 2 ).Value = Cells(x(i) + 2 , y(i) + 2 ).Value + 1
End If
If x(i) > 1 And x(i) < 10 And y(i) = 10 Then
Cells(x(i), y(i)).Value = Cells(x(i), y(i)).Value + 1
Cells(x(i), y(i) + 1 ).Value = Cells(x(i), y(i) + 1 ).Value + 1
Cells(x(i) + 1 , y(i)).Value = Cells(x(i) + 1 , y(i)).Value + 1
Cells(x(i) + 2 , y(i)).Value = Cells(x(i) + 2 , y(i)).Value + 1
Cells(x(i) + 2 , y(i) + 1 ).Value = Cells(x(i) + 2 , y(i) + 1 ).Value + 1
End If
If x(i) = 1 And y(i) = 1 Then
Cells(x(i) + 1 , y(i) + 2 ).Value = Cells(x(i) + 1 , y(i) + 2 ).Value + 1
Cells(x(i) + 2 , y(i) + 1 ).Value = Cells(x(i) + 2 , y(i) + 1 ).Value + 1
Cells(x(i) + 2 , y(i) + 2 ).Value = Cells(x(i) + 2 , y(i) + 2 ).Value + 1
End If
If x(i) = 10 And y(i) = 1 Then
Cells(x(i), y(i) + 1 ).Value = Cells(x(i), y(i) + 1 ).Value + 1
Cells(x(i), y(i) + 2 ).Value = Cells(x(i), y(i) + 2 ).Value + 1
Cells(x(i) + 1 , y(i) + 2 ).Value = Cells(x(i) + 1 , y(i) + 2 ).Value + 1
End If
If x(i) = 1 And y(i) = 10 Then
Cells(x(i) + 1 , y(i)).Value = Cells(x(i) + 1 , y(i)).Value + 1
Cells(x(i) + 2 , y(i)).Value = Cells(x(i) + 2 , y(i)).Value + 1
Cells(x(i) + 2 , y(i) + 1 ).Value = Cells(x(i) + 2 , y(i) + 1 ).Value + 1
End If
If x(i) = 10 And y(i) = 10 Then
Cells(x(i), y(i)).Value = Cells(x(i), y(i)).Value + 1
Cells(x(i), y(i) + 1 ).Value = Cells(x(i), y(i) + 1 ).Value + 1
Cells(x(i) + 1 , y(i)).Value = Cells(x(i) + 1 , y(i)).Value + 1
End If
Next
Range("B2:K11").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="99"
With Selection.FormatConditions( 1 ).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.Interior.ColorIndex = xlNone
Sheets("Game").Select
Cells( 1 , 1 ).Select
End Sub
Sub SetMine()
ActiveCell.FormulaR1C1 = "X"
YouWin
End Sub
Sub YouWin()
Dim i, j As Integer
Dim countX As Integer
countX = 0
For i = 2 To 11
For j = 2 To 11
If Cells(i, j).Value = "X" Then
If Sheets("Over").Cells(i, j).Value > 99 Then
countX = countX + 1
End If
End If
Next
Next
If countX = 10 Then
Sheets("Over").Select
Range("C13").Select
ActiveCell.FormulaR1C1 = "П"
Range("D13").Select
ActiveCell.FormulaR1C1 = "О"
Range("E13").Select
ActiveCell.FormulaR1C1 = "Б"
Range("F13").Select
ActiveCell.FormulaR1C1 = "Е"
Range("G13").Select
ActiveCell.FormulaR1C1 = "Д"
Range("H13").Select
ActiveCell.FormulaR1C1 = "А"
Range("I13").Select
ActiveCell.FormulaR1C1 = "!"
Range("J13").Select
ActiveCell.FormulaR1C1 = "!"
Range("C13:J13").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range("A1").Select
End If
End Sub
Sub OpenCell()
Dim r, c, x, y As Integer
r = ActiveCell.Row
c = ActiveCell.Column
If Sheets("Over").Cells(r, c).Value = 0 Then
ViewNull ActiveCell.Row, ActiveCell.Column
End If
If Sheets("Over").Cells(r, c).Value > 0 Then
Cells(r, c).Value = Sheets("Over").Cells(r, c).Value
Cells(r, c).Select
Selection.Interior.ColorIndex = xlNone
Selection.Font.ColorIndex = 0
End If
If Sheets("Over").Cells(r, c).Value > 99 Then
Sheets("Over").Select
Cells(r, c).Select
End If
End Sub
Sub ViewNull(x As Integer, y As Integer)
' MsgBox "0: x = " & x & "; y = " & y
If x > 1 And y > 1 And x < 12 And y < 12 Then
If Cells(x, y).Value = "" Or Cells(x, y).Value <> 0 Then
If Sheets("Over").Cells(x, y).Value = 0 Then
Cells(x, y).Value = 0
Cells(x, y).Select
Selection.Interior.ColorIndex = xlNone
Selection.Font.ColorIndex = 2
' ViewNull x - 1, y
' ViewNull x, y - 1
' ViewNull x, y + 1
' ViewNull x + 1, y
If x > 2 Then
Cells(x - 1 , y).Select
If Cells(x - 1 , y).Value = "" Then OpenCell
If y > 2 Then
Cells(x - 1 , y - 1 ).Select
If Cells(x - 1 , y - 1 ).Value = "" Then OpenCell
End If
If y < 11 Then
Cells(x - 1 , y + 1 ).Select
If Cells(x - 1 , y + 1 ).Value = "" Then OpenCell
End If
End If
If x < 11 Then
Cells(x + 1 , y).Select
If Cells(x + 1 , y).Value = "" Then OpenCell
If y > 2 Then
Cells(x + 1 , y - 1 ).Select
If Cells(x + 1 , y - 1 ).Value = "" Then OpenCell
End If
If y < 11 Then
Cells(x + 1 , y + 1 ).Select
If Cells(x + 1 , y + 1 ).Value = "" Then OpenCell
End If
End If
If y > 2 Then
Cells(x, y - 1 ).Select
If Cells(x, y - 1 ).Value = "" Then OpenCell
End If
If y < 11 Then
Cells(x, y + 1 ).Select
If Cells(x, y + 1 ).Value = "" Then OpenCell
End If
End If
End If
End If
End Sub
