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