While mouse cursor on top of A1 cell

Erdinç E. Karaçam · Sep 30, 2006

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:

Code:

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

malik641 · Sep 30, 2006

Very, very nice Ivan

Erdinç E. Karaçam · Sep 30, 2006

Hi,

Dear Ivan F Moala,

I can't beileve my eyes. API is unbelievable. Its works perfect.

One of my friend asked me a question about same matter in Türkiye. Can i share that code (together giving your name) with my other friends on internet?

Best regards...

DougStroud · Oct 1, 2006

How do you activate this to work? I read all the posts and copied this code into a regular module.
I reviewed the code, I have no experience w/ APIs.

Thanks,

Doug

Erdinç E. Karaçam · Oct 1, 2006

How do you activate this to work? I read all the posts and copied this code into a regular module.
I reviewed the code, I have experience w/ APIs.

Thanks,

Doug

Hi,

I copied this code too into a regular module. There is no problem. Code working fantastic.

I just asked to get a permission from Ivan F Moala to can i share modified versions of this code on our forum in Türkiye?

DougStroud · Oct 1, 2006

You just mouse over "A1"?
I tried that on my active sheet which is "Sheet8", but I see no change in "A1".

I would like to see this work as it sounds very cool.

Thanks,

ds

Legacy 98055 · Oct 1, 2006

Hi Ivan.

Doug. Run StartTimer or download the example and click on Start.

Here's an improvement using a boolean flag instead of two object references. It only changes the format when your mouse enters and exits the range. It also resets the format if your mouse moves over an area that is not a range. Download the example.

Erdinç. In my first reply I asked if you would need the ability to edit the target cell. If not, there is a lower cost way to do this.

MouseOverRange.zip

<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> 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

 Sub StartTimer()
 If Not m_blnTimerOn Then
 m_lngTimerId = SetTimer(0, 0, 3, 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
 Dim HoverRange As Range
 Static AmHovering As Boolean
 '
 On Error Resume Next
 GetCursorPos lngCurPos

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

 If HoverRange Is Nothing Then
 If AmHovering Then
 AmHovering = False
 With Range("A1")
 .Value = "Mouse Not Over"
 .Font.Size = 10
 .Font.ColorIndex = 0
 End With
 End If
 Exit Function
 End If

 If HoverRange.Address = "$A$1" Then
 If Not AmHovering Then
 AmHovering = True
 With Range("A1")
 .Value = "Mouse Over"
 .Font.Size = 14
 .Font.ColorIndex = 3
 End With
 End If
 Else
 If AmHovering Then
 AmHovering = False
 With Range("A1")
 .Value = "Mouse Not Over"
 .Font.Size = 10
 .Font.ColorIndex = 0
 End With
 End If
 End If

 End Function

 Sub StopTimer()
 If m_blnTimerOn Then
 KillTimer 0, m_lngTimerId
 m_blnTimerOn = False
 End If
 End Sub
</td></tr></table><button onclick='document.all("101200691643843").value=document.all("101200691643843").value.replace(/ \s\s/g,"");document.all("101200691643843").value=document.all("101200691643843").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("101200691643843").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="101200691643843" wrap="virtual">
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

Sub StartTimer()
If Not m_blnTimerOn Then
m_lngTimerId = SetTimer(0, 0, 3, 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
Dim HoverRange As Range
Static AmHovering As Boolean
'
On Error Resume Next
GetCursorPos lngCurPos

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

If HoverRange Is Nothing Then
If AmHovering Then
AmHovering = False
With Range("A1")
.Value = "Mouse Not Over"
.Font.Size = 10
.Font.ColorIndex = 0
End With
End If
Exit Function
End If

If HoverRange.Address = "$A$1" Then
If Not AmHovering Then
AmHovering = True
With Range("A1")
.Value = "Mouse Over"
.Font.Size = 14
.Font.ColorIndex = 3
End With
End If
Else
If AmHovering Then
AmHovering = False
With Range("A1")
.Value = "Mouse Not Over"
.Font.Size = 10
.Font.ColorIndex = 0
End With
End If
End If

End Function

Sub StopTimer()
If m_blnTimerOn Then
KillTimer 0, m_lngTimerId
m_blnTimerOn = False
End If
End Sub</textarea>

MouseOverRange.zip

DougStroud · Oct 1, 2006

Tom,
I was successful in seeing how this would work by downloading your file and pushing the "Start" button.
Just for more "knowledge" reasons, in Erdinç orginial post, were there buttons needed to have this code execute to achieve the results? As I wrote in my previous post, just by copying the code into a module I did not see the code take effect.

thanks,

ds

Legacy 98055 · Oct 1, 2006

Hi Doug. No. The buttons are not needed. However, you do need to start and stop the code somehow or another. It really depends on exactly how the OP will be using this. Here is an example that uses several of the workbook's event procedures that will start the process when you open the workbook using the "Workbook_Open" event procedure and then stop it when you close the workbook using the "Workbook_BeforeClose" event procedure. This is all done automatically with no user intervention. The buttons have been removed in this example.

MouseOverRange_2.zip

DougStroud · Oct 1, 2006

Hi Tom,
Ok... that is cool, thanks for the explanation. That clears up quite a bit of the mystery. One more question, just for curiosity sake... What did you do to start the code in the second example w/out needing the buttons from example #1?

Thanks again, I have learned quite a bit from your posts/contributions.

Doug

Legacy 98055 · Oct 1, 2006

In my previous post I mentioned event procedures. These are pocedures that run in repsonse to specific actions or at specific times. For example, when you open your workbook, the Workbook_Open event fires automatically. You can place code in this procedure to do "stuff".

When you close the workbook, the Workbook_BeforeClose fires.

In the example I attached to my last post, the code is started by calling the StartTimer procedure from the Workbook_Open event and then it is stopped by calling the StopTimer procedure from Workbook_BeforeClose event.

Code:

Private Sub Workbook_Open()
    StartTimer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTimer
End Sub

While mouse cursor on top of A1 cell

Erdinç E. Karaçam

Board Regular

malik641

Board Regular

Excel Facts

Erdinç E. Karaçam

Board Regular

DougStroud

Well-known Member

Erdinç E. Karaçam

Board Regular

DougStroud

Well-known Member

Legacy 98055

Guest

DougStroud

Well-known Member

Legacy 98055

Guest

DougStroud

Well-known Member

Legacy 98055

Guest

Similar threads

Forum statistics

Share this page

While mouse cursor on top of A1 cell

Board Regular

Board Regular

Excel Facts

Board Regular

Well-known Member

Board Regular

Well-known Member

Legacy 98055

Guest

Well-known Member

Legacy 98055

Guest

Well-known Member

Legacy 98055

Guest

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock