Hi Guys
Can't claim your prize Tom, but I have been playing with some of this code and come up with this that lets you draw a picture with your cursor (sort of).
Might be fun for kids.
It has two event macros and one standard macro. Before pasting the code, set up the worksheet so that cells A1:CP60 are sized to fill the screen, color the cells black (and hide column A ...to hide flicker in A1).
Drawing is initiated by right mouse click. Stop it by pressing the keyboard space bar. Clear it by selecting any cell.
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Address = "$A$1" Then Exit Sub
Set Rng = Range("A1:CP60")
Rng.FormatConditions.Delete
Application.Run "Test"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
[a1].Select
Set Rng = Range("A1:CP60")
Rng.FormatConditions.Delete
End Sub
Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Integer) As Long
Const VK_SPACE As Long = &H20
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Option Base 1
Public Type POINTAPI
x As Long
y As Long
End Type
Dim RwsTop()
Dim ClmnsLeft()
Dim lngCurPos As POINTAPI
Dim Rng As Range
Sub Test()
On Error Resume Next
Set Rng = Range("A1:CP60")
ReDim RwsTop(1 To Rng.Rows.Count, 2)
ReDim ClmnsLeft(1 To Rng.Columns.Count, 2)
i = 1
For Each Rw In Rng.Rows
RwsTop(i, 1) = ActiveWindow.PointsToScreenPixelsY(Rw.Top)
RwsTop(i, 2) = Rw.Row
i = i + 1
Next
i = 1
For Each Clmn In Rng.Columns
ClmnsLeft(i, 1) = ActiveWindow.PointsToScreenPixelsX(Clmn.Left)
ClmnsLeft(i, 2) = Clmn.Column
i = i + 1
Next
Do
If GetAsyncKeyState(&H20) Then GoTo errorhandler
Application.ScreenUpdating = False
GetCursorPos lngCurPos
Column = Application.WorksheetFunction.VLookup(lngCurPos.x, ClmnsLeft, 2, True)
Row = Application.WorksheetFunction.VLookup(lngCurPos.y, RwsTop, 2, True)
Cells(1, 1) = Cells(Row, Column).Address
DoEvents
If Cells(1, 1).Address <> Cells(Row, Column).Address Then GoTo here
Rng.FormatConditions.Delete
here:
Range(Cells(1, 1)).FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
Range(Cells(1, 1)).FormatConditions(1).Interior.ColorIndex = Int((56 * rnd) + 1) 'Range(Cells(1, 1)).Row + Range(Cells(1, 1)).Column
Application.ScreenUpdating = True
Loop
errorhandler:
[a1].Select
End Sub
have fun
Derek
