By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,956 Members | 1,683 Online
Bytes IT Community
Submit an Article
Got Smarts?
Share your bits of IT knowledge by writing an article on Bytes.

VBA Minesweeper - Take advantage of your Mouse in an Excel's Worksheet.

kadghar
Expert 100+
P: 1,295
Most of the times VBA is used with variables. Objects (such as worksheets, cells or databases) are only used when we read their properties (value, formula, font...) or we use a method (save, open...). But their events are rarely used, and mainly when working with MS Forms.

Excel has two very important object types: Workbook and Worksheet, which besides their properties and methods, they have events.

The Worksheet's events are not shown in any combobox in the code editor, but you can have a list of them, by simply pressing F2 (to see the object browser).

The Worksheet's events are:

Activate
BeforeDoubleClick
BeforeRightClick
Calculate
Change
Deactivate
FollowHyperlink
PivotTableUpdate
SelectionChange

As you can see, many of them have something to do with 'What we do with our mouse'.

First i'll tell you what this thing do, and the full code is below, so you can copy-paste it to start playing Minesweeper in your worksheet...
... Yes! you'll play Minesweeper in a worksheet, that is what this tutorial is all about.

Lets create a public 2D array called Mines (wow, very original), sized 11x11 (actually, the starter Minesweeper board is 9x9, but to use an 'universal algorithm' to count the mines near a square, i'll leave the borders empty instead of making special cases for each border, but yes, our board will be 9x9)

The first Sub i'll make is called 'Generate' (i know my creativity is outstanding, i'm on fire ^.^).

'Generate' will change the size of the cells so they look like squares, then it'll put 10 "X" in the array (at random) and then will fill with numbers the rest of the array. The algorithm is quite simple, just give it a look.

Then it'll hide the rows and columns that we dont need (have in mind this code was made for Excel 2003, while working with Excel 2007, you might need to change this ranges).

Now, to work fine with our events, lets declare the GetAsyncKeyState function, and lets create a simple Boolean Function called RightButton that'll indicate if the mouse's Right button is pressed.

Well, now its time for our two main Events ^.^, i'll do everything in the SelectionChange event. But when a flag is placed, it'll use the BeforeRightClick event too. Please note their parameters are ranges called Target and they're BYVAL. For BeforeRightClick you also have a boolean called Cancel (which by the way, is a ByRef instead of a ByVal).

Now, just place the code below in the Sheet1 or Sheet2 or any sheet's code window, and run the 'Generate' sub to start playing. Check the comments to see how it works.

It's very important to have in mind the order of the events. When you click the Right button on a cell, first you'll change the selection, then the right button is detonated. So the SelectionChange event will always run before the BeforeRightClick one.
Expand|Select|Wrap|Line Numbers
  1. Option Explicit
  2. Dim Mines(1 To 11, 1 To 11)
  3. Sub Generate()
  4. Dim i(1 To 2) As Integer, j As Integer, k As Integer
  5. '------------------------------'
  6. 'Give a nice look to our board '
  7. '------------------------------'
  8. With Range(Cells(2, 2), Cells(10, 10))
  9.     .Value = ""
  10.     .Borders.LineStyle = xlContinuous
  11.     .Interior.ColorIndex = 15
  12. End With
  13. Columns("A:K").ColumnWidth = 3
  14. Rows("1:11").RowHeight = 18
  15. Columns("L:IV").Hidden = True
  16. Rows("12:65536").Hidden = True
  17. '----------------------------'
  18. 'Put some mines in the array '
  19. '----------------------------'
  20. 'Note i wont touch the first nor the last Row/Column
  21. Randomize
  22. Do
  23.     i(1) = Int(Rnd * 9) + 2
  24.     i(2) = Int(Rnd * 9) + 2
  25.     If Mines(i(1), i(2)) <> "X" Then
  26.         Mines(i(1), i(2)) = "X"
  27.         j = j + 1
  28.     End If
  29. Loop Until j = 10
  30. '--------------------------------------------------------------'
  31. 'Count the mines around each other place, and write the number '
  32. '--------------------------------------------------------------'
  33. For j = 2 To 10
  34.      For k = 2 To 10
  35.         If Mines(j, k) <> "X" Then
  36.             Mines(j, k) = 0
  37.             If Mines(j - 1, k - 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
  38.             If Mines(j - 1, k) = "X" Then Mines(j, k) = Mines(j, k) + 1
  39.             If Mines(j - 1, k + 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
  40.             If Mines(j, k - 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
  41.             If Mines(j, k + 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
  42.             If Mines(j + 1, k - 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
  43.             If Mines(j + 1, k) = "X" Then Mines(j, k) = Mines(j, k) + 1
  44.             If Mines(j + 1, k + 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
  45.         End If
  46.     Next
  47. Next
  48. 'Lets keep this cell selected
  49. Cells(1, 1).Select
  50. End Sub
  51.  
  52. Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  53.  
  54. Function RightButton() As Boolean
  55.     RightButton = (GetAsyncKeyState(vbKeyRButton) And &H8000)
  56. End Function
  57.  
  58. Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  59.     Cancel = True 'So the right button menu is not displayed.
  60.     'If the cell is already clear, then exit.
  61.     If Target.Interior.ColorIndex = -4142 Then Exit Sub
  62.     'If it has a flag, then remove it.
  63.     If Target.Value = "F" Then
  64.         Target.Value = ""
  65.         Target.Interior.ColorIndex = 15
  66.     'If it doesnt have it, then place it.
  67.     Else
  68.         Target.Value = "F"
  69.         Target.Interior.ColorIndex = 16
  70.     End If
  71.     Cells(1, 1).Select 'and keep this cell selected.
  72. End Sub
  73.  
  74. Sub Worksheet_SelectionChange(ByVal Target As Range)
  75. Dim Count As Integer
  76. Dim R1 As Long, R2 As Long
  77. '---------------------------------------------------------------------'
  78. 'If the user selects a range, only the first cell will keep selected. '
  79. '---------------------------------------------------------------------'
  80. If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
  81.     Cells(Target.Row, Target.Column).Select
  82.     Exit Sub
  83. End If
  84. On Error GoTo Err1 'An error handler, yeah!
  85. R1 = Target.Row: R2 = Target.Column 'This is just because im lazy, but they're not necessary
  86. 'Lets make sure this code will only work inside our board.
  87. If R1 > 10 Or R2 > 10 Then Exit Sub
  88. If R1 < 2 Or R2 < 2 Then Exit Sub
  89. '---------------------------------------------------------------'
  90. 'Placing/removing a flag is not this event's problem.           '
  91. 'Please note that the event BeforeRightClick is activated when  '
  92. 'the right button is pressed. So there's no need of calling it  '
  93. 'we only have to exit this one.                                 '
  94. '---------------------------------------------------------------'
  95. If RightButton Then
  96.     Exit Sub
  97. End If
  98. 'If a sqare's back color is 'None' (-4121) is because we've already
  99. 'clicked on it, so lets exit this thing.
  100. If Target.Value <> "" Or Target.Interior.ColorIndex = -4142 Then
  101.     Cells(1, 1).Select
  102.     Exit Sub
  103. End If
  104. '--------------------------------------------------------------------------'
  105. 'Ah, this is the nice part, we put the mine's array value into the cell    '
  106. 'and follow a simple algorithm for cleaning what's around if the value is  '
  107. 'zero. It's not that hard to understand.                                   '
  108. 'Or just restart the game if a mine explodes.                              '
  109. '--------------------------------------------------------------------------'
  110. Target.Value = Mines(R1, R2)
  111. Target.Interior.ColorIndex = 0
  112. Target.Font.ColorIndex = 0
  113. If Mines(R1, R2) = "X" Then
  114.     Target.Interior.ColorIndex = 3
  115.     MsgBox "game over"
  116.     Generate
  117.     Exit Sub
  118. End If
  119. If Mines(R1, R2) = "0" Then
  120.     Target.Font.ColorIndex = 2
  121.     Cells(R1 - 1, R2 - 1).Select
  122.     Cells(R1 - 1, R2).Select
  123.     Cells(R1 - 1, R2 + 1).Select
  124.     Cells(R1, R2 - 1).Select
  125.     Cells(R1, R2 + 1).Select
  126.     Cells(R1 + 1, R2 - 1).Select
  127.     Cells(R1 + 1, R2).Select
  128.     Cells(R1 + 1, R2 + 1).Select
  129. End If
  130. Cells(1, 1).Select 'Lets keep this cell selected
  131. Exit Sub
  132. Err1:
  133. Cells(1, 1).Select 'always selected
  134. Generate
  135. End Sub
Im sure you'll find it fun (if not the code, at least the game).

^.^

Kad
Apr 28 '08 #1
Share this Article
Share on Google+
5 Comments


NeoPa
Expert Mod 15k+
P: 31,342
Kad,

You will find the Workbook & Worksheet specific events in the dropdown on the right (the event list) if you select the Workbook or Worksheet from the dropdown on the left (the object list).

By default this is set to (General), which will show (Declarations).
Apr 30 '08 #2

P: 1
I am currently trying to program minesweeper for a class. I have one comment on how you generate the bombs. You are using a Do-Loop and loop until j = 10. The way you have it, If the random function tries to put a bomb in a cell that already has a bomb, it simply won't. But the program will still go through j = j + 1, hence the counter will go up. So technically when you run this program, you might not get 10 bombs every time, because if the random function lands a bomb on a bomb, no bomb will be placed and the counter will still go up.

I hope this isn't too confusing- I'm very new at VBA and can not explain it well. But I did come up with a slightly different random bomb-placing program that will consistently place 10 bombs. Anyway, tell me what you think
Expand|Select|Wrap|Line Numbers
  1. Randomize
  2. For n = 1 To 10
  3. Do
  4.     i = Int(10 * Rnd) + 2
  5.     j = Int(10 * Rnd) + 2
  6.  
  7.     If mine(i, j) <> "X" Then
  8.         mine(i, j) = "X"
  9.         Exit Do
  10.     End If
  11. Loop
  12. Next n
Dec 13 '08 #3

NeoPa
Expert Mod 15k+
P: 31,342
Interesting point (and it does make perfect sense by the way).

I would only suggest that the Do loop should be indented as the For loop is.

Welcome to Bytes!
Dec 16 '08 #4

kadghar
Expert 100+
P: 1,295
Sorry i didnt answer before.

Cmeier7, yes, it wouldn't make sense if the j = j+1 were outside the IF, but its in it, so only when the bomb is planted it'll add 1 to j. Just as you said it should be, it is.

About your code. I think is another nice way to do it.

^.^

happy new year (a little bit late)
Jan 16 '09 #5

P: 61
I like this code, pretty cool. One small hickup I found, if you hit the X too many times in a row the array doesn't get cleared and all the cells end up being X's. this is what I did to remedy that..
Expand|Select|Wrap|Line Numbers
  1. If Mines(R1, R2) = "X" Then
  2.     Target.Interior.ColorIndex = 3
  3.     Erase Mines
  4.     MsgBox "game over"
  5.     Generate
  6.     Exit Sub
  7. End If
  8.  
I added the erase mines to clear the array. Works perfecly now.

Thanks for the awsome code:-)
Oct 28 '10 #6