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

[kadghar]

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
BeforeDoubleCli ck
BeforeRightClic k
Calculate
Change
Deactivate
FollowHyperlink
PivotTableUpdat e
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 GetAsyncKeyStat e 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 BeforeRightClic k event too. Please note their parameters are ranges called Target and they're BYVAL. For BeforeRightClic k 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 BeforeRightClic k one.
[CODE=vb]
Option Explicit
Dim Mines(1 To 11, 1 To 11)
Sub Generate()
Dim i(1 To 2) As Integer, j As Integer, k As Integer
'------------------------------'
'Give a nice look to our board '
'------------------------------'
With Range(Cells(2, 2), Cells(10, 10))
.Value = ""
.Borders.LineSt yle = xlContinuous
.Interior.Color Index = 15
End With
Columns("A:K"). ColumnWidth = 3
Rows("1:11").Ro wHeight = 18
Columns("L:IV") .Hidden = True
Rows("12:65536" ).Hidden = True
'----------------------------'
'Put some mines in the array '
'----------------------------'
'Note i wont touch the first nor the last Row/Column
Randomize
Do
i(1) = Int(Rnd * 9) + 2
i(2) = Int(Rnd * 9) + 2
If Mines(i(1), i(2)) <> "X" Then
Mines(i(1), i(2)) = "X"
j = j + 1
End If
Loop Until j = 10
'--------------------------------------------------------------'
'Count the mines around each other place, and write the number '
'--------------------------------------------------------------'
For j = 2 To 10
For k = 2 To 10
If Mines(j, k) <> "X" Then
Mines(j, k) = 0
If Mines(j - 1, k - 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
If Mines(j - 1, k) = "X" Then Mines(j, k) = Mines(j, k) + 1
If Mines(j - 1, k + 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
If Mines(j, k - 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
If Mines(j, k + 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
If Mines(j + 1, k - 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
If Mines(j + 1, k) = "X" Then Mines(j, k) = Mines(j, k) + 1
If Mines(j + 1, k + 1) = "X" Then Mines(j, k) = Mines(j, k) + 1
End If
Next
Next
'Lets keep this cell selected
Cells(1, 1).Select
End Sub

Private Declare Function GetAsyncKeyStat e Lib "user32" (ByVal vKey As Long) As Integer

Function RightButton() As Boolean
RightButton = (GetAsyncKeySta te(vbKeyRButton ) And &H8000)
End Function

Sub Worksheet_Befor eRightClick(ByV al Target As Range, Cancel As Boolean)
Cancel = True 'So the right button menu is not displayed.
'If the cell is already clear, then exit.
If Target.Interior .ColorIndex = -4142 Then Exit Sub
'If it has a flag, then remove it.
If Target.Value = "F" Then
Target.Value = ""
Target.Interior .ColorIndex = 15
'If it doesnt have it, then place it.
Else
Target.Value = "F"
Target.Interior .ColorIndex = 16
End If
Cells(1, 1).Select 'and keep this cell selected.
End Sub

Sub Worksheet_Selec tionChange(ByVa l Target As Range)
Dim Count As Integer
Dim R1 As Long, R2 As Long
'---------------------------------------------------------------------'
'If the user selects a range, only the first cell will keep selected. '
'---------------------------------------------------------------------'
If Target.Rows.Cou nt > 1 Or Target.Columns. Count > 1 Then
Cells(Target.Ro w, Target.Column). Select
Exit Sub
End If
On Error GoTo Err1 'An error handler, yeah!
R1 = Target.Row: R2 = Target.Column 'This is just because im lazy, but they're not necessary
'Lets make sure this code will only work inside our board.
If R1 > 10 Or R2 > 10 Then Exit Sub
If R1 < 2 Or R2 < 2 Then Exit Sub
'---------------------------------------------------------------'
'Placing/removing a flag is not this event's problem. '
'Please note that the event BeforeRightClic k is activated when '
'the right button is pressed. So there's no need of calling it '
'we only have to exit this one. '
'---------------------------------------------------------------'
If RightButton Then
Exit Sub
End If
'If a sqare's back color is 'None' (-4121) is because we've already
'clicked on it, so lets exit this thing.
If Target.Value <> "" Or Target.Interior .ColorIndex = -4142 Then
Cells(1, 1).Select
Exit Sub
End If
'--------------------------------------------------------------------------'
'Ah, this is the nice part, we put the mine's array value into the cell '
'and follow a simple algorithm for cleaning what's around if the value is '
'zero. It's not that hard to understand. '
'Or just restart the game if a mine explodes. '
'--------------------------------------------------------------------------'
Target.Value = Mines(R1, R2)
Target.Interior .ColorIndex = 0
Target.Font.Col orIndex = 0
If Mines(R1, R2) = "X" Then
Target.Interior .ColorIndex = 3
MsgBox "game over"
Generate
Exit Sub
End If
If Mines(R1, R2) = "0" Then
Target.Font.Col orIndex = 2
Cells(R1 - 1, R2 - 1).Select
Cells(R1 - 1, R2).Select
Cells(R1 - 1, R2 + 1).Select
Cells(R1, R2 - 1).Select
Cells(R1, R2 + 1).Select
Cells(R1 + 1, R2 - 1).Select
Cells(R1 + 1, R2).Select
Cells(R1 + 1, R2 + 1).Select
End If
Cells(1, 1).Select 'Lets keep this cell selected
Exit Sub
Err1:
Cells(1, 1).Select 'always selected
Generate
End Sub[/CODE]

Im sure you'll find it fun (if not the code, at least the game).

^.^

Kad

[NeoPa]

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).

[cmeier7]

Generating bombs

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

Randomize
For n = 1 To 10
Do
    i = Int(10 * Rnd) + 2
    j = Int(10 * Rnd) + 2

    If mine(i, j) <> "X" Then
        mine(i, j) = "X"
        Exit Do
    End If
Loop
Next n

[NeoPa]

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!

[kadghar]

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)

[Rodney Roe]

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

If Mines(R1, R2) = "X" Then
    Target.Interior.ColorIndex = 3
    Erase Mines
    MsgBox "game over"
    Generate
    Exit Sub
End If

I added the erase mines to clear the array. Works perfecly now.

Thanks for the awsome code:-)