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

kadghar · #1 April 28th, 2008, 06:44 PM

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

 
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.LineStyle = xlContinuous

    .Interior.ColorIndex = 15

End With

Columns("A:K").ColumnWidth = 3

Rows("1:11").RowHeight = 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 GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
 
Function RightButton() As Boolean

    RightButton = (GetAsyncKeyState(vbKeyRButton) And &H8000)

End Function
 
Sub Worksheet_BeforeRightClick(ByVal 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_SelectionChange(ByVal 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.Count > 1 Or Target.Columns.Count > 1 Then

    Cells(Target.Row, 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 BeforeRightClick 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.ColorIndex = 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.ColorIndex = 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

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

^.^

Kad

NeoPa · #2 April 30th, 2008, 01:19 AM

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 · #3 December 13th, 2008, 12:08 AM

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

 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 · #4 December 16th, 2008, 04:41 PM

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 · #5 January 16th, 2009, 05:14 PM

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)

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

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

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

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

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

/bytes/development

/bytes/it

/bytes/about