Game security code needed
 

I probably just have no idea what I am doing. But I can't
for the life of me figure out how to run this. can anyone
help?
-----Original Message-----
We had this really imporant meeting with the Chief Exec
this morning and
the two most senior sales reps were invited as
a "consultation exercise"

Knowing the reps would be bored, I spent 15 long minutes
developing an
app to keep them occupied in the meeting (code below)

However, no more than 5 minutes into the meeting, not
only were they
projecting the worksheet over my masterly whiteboard
presentation but
they were also /cheating/ at noughts and crosses.

Can anyone provide any code to stop them cheating in
future meetings
please? Something to stop there being 5 crosses and one
nought on the
board would be a start :-)

Private Sub Worksheet_BeforeRightClick(ByVal Target As
Range, _
Cancel As Boolean)
'noughts and crosses (tic-tac-toe) in A1:C3
Dim x%
Static s$
With Target
If .Cells.Count 1 Then Exit Sub
If .Row 3 Or .Column 3 Then Exit Sub
If .Value < "" Then Exit Sub
If s$ = "X" Then s$ = "O" Else s$ = "X"
.Formula = s$
Cancel = True
x% = .Column
Application.StatusBar = False
If Cells(1, x%).Value = Cells(2, x%).Value Then
If Cells(1, x%).Value = Cells(3, x%).Value Then
Application.StatusBar = .Value & " Wins (column)"
Exit Sub
End If
End If
x% = .Row
If Cells(x%, 1).Value = Cells(x%, 2).Value Then
If Cells(x%, 1).Value = Cells(x%, 3).Value Then
Application.StatusBar = .Value & " Wins (row)"
Exit Sub
End If
End If
'don't check diagonals if center square blank
If Cells(2, 2).Value = "" Then Exit Sub
If Cells(1, 1).Value = Cells(2, 2).Value Then
If Cells(1, 1).Value = Cells(3, 3).Value Then
Application.StatusBar = .Value & " Wins (diag)"
End If
End If
If Cells(1, 3).Value = Cells(2, 2).Value Then
If Cells(1, 3).Value = Cells(3, 1).Value Then
Application.StatusBar = .Value & " Wins (diag2)"
End If
End If
End With
End Sub

.

Game security code needed
 

Look at the original thread - there was a bit of discussion:

http://groups.google.com/groups?thre...gp13.phx .gbl

but to run the code you posted, right click on a sheet tab and select view
code. Paste the code in the resulting module. Clean up any errors due to
word wrap. Now go to the worksheet and right click in the Range("A1:C3) -
the code should run and place an X or O for each right click in that range
until a winner has been determined - look down at the status bar. Not a
whole lot of visual feedback.


--
Regards,
Tom Ogilvy

wrote in message
...
I probably just have no idea what I am doing. But I can't
for the life of me figure out how to run this. can anyone
help?
-----Original Message-----
We had this really imporant meeting with the Chief Exec
this morning and
the two most senior sales reps were invited as
a "consultation exercise"

Knowing the reps would be bored, I spent 15 long minutes
developing an
app to keep them occupied in the meeting (code below)

However, no more than 5 minutes into the meeting, not
only were they
projecting the worksheet over my masterly whiteboard
presentation but
they were also /cheating/ at noughts and crosses.

Can anyone provide any code to stop them cheating in
future meetings
please? Something to stop there being 5 crosses and one
nought on the
board would be a start :-)

Private Sub Worksheet_BeforeRightClick(ByVal Target As
Range, _
Cancel As Boolean)
'noughts and crosses (tic-tac-toe) in A1:C3
Dim x%
Static s$
With Target
If .Cells.Count 1 Then Exit Sub
If .Row 3 Or .Column 3 Then Exit Sub
If .Value < "" Then Exit Sub
If s$ = "X" Then s$ = "O" Else s$ = "X"
.Formula = s$
Cancel = True
x% = .Column
Application.StatusBar = False
If Cells(1, x%).Value = Cells(2, x%).Value Then
If Cells(1, x%).Value = Cells(3, x%).Value Then
Application.StatusBar = .Value & " Wins (column)"
Exit Sub
End If
End If
x% = .Row
If Cells(x%, 1).Value = Cells(x%, 2).Value Then
If Cells(x%, 1).Value = Cells(x%, 3).Value Then
Application.StatusBar = .Value & " Wins (row)"
Exit Sub
End If
End If
'don't check diagonals if center square blank
If Cells(2, 2).Value = "" Then Exit Sub
If Cells(1, 1).Value = Cells(2, 2).Value Then
If Cells(1, 1).Value = Cells(3, 3).Value Then
Application.StatusBar = .Value & " Wins (diag)"
End If
End If
If Cells(1, 3).Value = Cells(2, 2).Value Then
If Cells(1, 3).Value = Cells(3, 1).Value Then
Application.StatusBar = .Value & " Wins (diag2)"
End If
End If
End With
End Sub

.