While mouse cursor on top of A1 cell

[Erdinç E. Karaçam]

Hi everyone,

I would like to change A1 cell's Interior.ColorIndex to red color and A1's font format to Italic, while mouse cursor on top of A1 cell.

Can i do it with a VBA code or any different way to do it?

Thanks a lot.


For a funny example:

Sub CursorOnA1() 
    If MouseCursor OnTopOf [A1] Then 
        With [A1] 
            .Interior.ColorIndex = 3 
            .Font.Italic = True 
        End If 
    End If 
End Sub

 

[Legacy 98055]

Does A1 have to be available for direct editing (in the cell editing)?

 

[steve case]

Doesn't work for me, the line:

If MouseCursor OnTopOf [A1] Then

Comes up red in Visual Basic Editor

 

[Legacy 98055]

Pseudo Code my Brother....

 

[Norie]

Tom

Cross-post my friend.

 

[Legacy 98055]

Hi Norie. The answer from DRJ with Guru status says you can't do it. I disagree. You can do it, but, depending on rather the OP needs to directly edit in the cell, will lend to differing levels of complexity. So is this an official crosspost if the answer from another board's "Guru" is "no"?

 

[Norie]

Tom

Not sure how you would define an 'official' cross-post, just thought I'd give you a heads-up.

When I saw the original post over at the other forum I also thought it would be possible, but realised it would probably involve using the Windows API and/or other complicated code.

The OP seemed fine with the response that it wasn't possible, so I was suprised to see the question posted here.

If you think it's possible then it probably is.

 

[Erdinç E. Karaçam]

Hi everyone

I asked this question an another Forum and Guru said me that is not possible for a worksheet.

I think this answer should be true. But i am still thinking of API's benefits and i am saying myself hey Erdinç! maybe you can find a way to do it by an API.

But finally i don't know what going to be end of my this wonder.

Anyway, Thank you you very much you all.

Best regards.

 

[Ivan F Moala]

Yes you can do this via API's

There is a performance hit however.

 

[Ivan F Moala]

sorry, having problems posting ..... 3rd attempt

call Starttimer and Stoptimer when required ....

Option Explicit
'//
'// Cursor pos orig by rafaaj2000

'// Addressof routines found here;
'// http://www.xcelfiles.com/API_09.html
'// http://www.xcelfiles.com/VBA_Clock.html

'// Timer routines;
'// http://www.xcelfiles.com/API_02.html
'//


Declare Function SetTimer _
    Lib "user32" ( _
        ByVal hWnd As Long, _
        ByVal nIDEvent As Long, _
        ByVal uElapse As Long, _
        ByVal lpTimerFunc As Long) _
As Long

Declare Function KillTimer _
    Lib "user32" ( _
        ByVal hWnd As Long, _
        ByVal nIDEvent As Long) _
As Long

Declare Function GetCursorPos _
    Lib "user32" ( _
        lpPoint As POINTAPI) _
As Long

Type POINTAPI
    x As Long
    Y As Long
End Type

Dim m_blnTimerOn As Boolean
Dim m_lngTimerId As Long
Dim m_NewRange As Range
Dim m_OldRange As Range

Sub StartTimer()
If Not m_blnTimerOn Then
    m_lngTimerId = SetTimer(0, 0, 0.05, AddressOf TimerProc)
    m_blnTimerOn = True
End If
End Sub

Public Function TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim lngCurPos As POINTAPI
'
On Error Resume Next
GetCursorPos lngCurPos

Set m_NewRange = ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.Y)

If m_NewRange.Address <> m_OldRange.Address Then
    With Range("A1")
        .Font.ColorIndex = 0
        .Font.Italic = False
    End With
End If

If m_NewRange.Address = "$A$1" Then
    With Range("A1")
        .Font.ColorIndex = 3
        .Font.Italic = True
    End With
End If
    
'//
Set m_OldRange = m_NewRange
TimerProc = 0

End Function

Sub StopTimer()
If m_blnTimerOn Then
    KillTimer 0, m_lngTimerId
    m_blnTimerOn = False
End If
End Sub