Hover Over / VS selecting the cell

[Drrellik]

Hello all,


I have read these two posts about Hover over and wanted to ask if there have been any updates in excel over the years that might allow this to happen now.

https://www.mrexcel.com/forum/excel-questions/515724-show-contents-cell-when-hovering.html
https://www.mrexcel.com/forum/excel-questions/87158-change-color-cell-when-moving-mouse-over.html


I am not after a 12 pack or some bread, but rather curious to see if it can be done now due to updates.

I have a random math problem generator for my kids that uses the random function to create the problems and calculates the correct answer and I have the cell and content value set to white. If the hover over the answer cell and I could get it to change color they could check their answer.

As you know with the Rand() function if you hit enter or oneof several other keys the problems all change.

Not a show stopper, just thought it would be cool

Don

 

[Jaafar Tribak]

Here is an easier, a more stable and much better approach that doesn't require the use of a timer,mouse hook or loop and should also work on 32 and 64bit excel:

Workbook example.

For easy use, the code contains a pseudo-event named (OnCellMouseHover)... This pseudo-event takes an argument which holds the current cell under the mouse pointer.


Code in the ThisWorkbook Module:

Option Explicit

Private WithEvents Cmbrs As CommandBars

Private Type POINTAPI
    x As Long
    y As Long
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Private Sub Workbook_Activate()
    Set Cmbrs = Application.CommandBars
    Call Cmbrs_OnUpdate
End Sub

Private Sub Workbook_Deactivate()
    Call OnCellMouseHover(Nothing)
    Set Cmbrs = Nothing
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set Cmbrs = Application.CommandBars
    Call Cmbrs_OnUpdate
End Sub


Private Sub Cmbrs_OnUpdate()

    Static lPrevColor As Long
    Static oPrevCell As Range
    Dim oCurCell  As Range
    Dim tCurPos As POINTAPI
    
    On Error Resume Next
    
    If GetActiveWindow <> Application.Hwnd Then
        Call OnCellMouseHover(Nothing)
        Exit Sub
    End If

    Application.CommandBars.FindControl(ID:=2040).Enabled = Not Application.CommandBars.FindControl(ID:=2040).Enabled

    GetCursorPos tCurPos
    Set oCurCell = ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)
    
    If oPrevCell.Address <> oCurCell.Address Then
        Set oPrevCell = oCurCell
        Call OnCellMouseHover(oCurCell)
    End If
 
End Sub



[COLOR=#008000][B]'************************************************************
'                   PSEUDO-EVENT
'************************************************************[/B][/COLOR]
Private Sub OnCellMouseHover(ByVal CellUnderMousePointer As Range)

    Static oPrevCell As Range
    Static lPrevColor As Long

    On Error Resume Next

    If CellUnderMousePointer Is Nothing Then
        oPrevCell.Interior.ColorIndex = lPrevColor
    End If
    
    [B][COLOR=#008000]'Apply to Sheet1 only - Remove this line to apply to all sheets.[/COLOR][/B]
    If CellUnderMousePointer.Parent.Name <> "Sheet1" Then Exit Sub

    If oPrevCell.Address <> CellUnderMousePointer.Address Then
        If Not CellUnderMousePointer Is Nothing Then
            oPrevCell.Interior.ColorIndex = lPrevColor
            Set oPrevCell = CellUnderMousePointer
            lPrevColor = CellUnderMousePointer.Interior.ColorIndex
            CellUnderMousePointer.Interior.ColorIndex = 3
        End If
    End If
    
End Sub

 

[Drrellik]

This works nicely. I can change the cell color from red to what ever I want. I have to make sure it is only in 'This workbook' Thank you again you should enjoy the brew and bread...

 

[Jaafar Tribak]

This works nicely. I can change the cell color from red to what ever I want. I have to make sure it is only in 'This workbook' Thank you again you should enjoy the brew and bread...

By default, it works only on the workbook containing the code ... other workbooks are not affected.

Thanks for the feedback.

 

[Dan_W]

Hi @Jaafar Tribak - I'm finally getting around to working my way through all your different code samples you've kindly uploaded onto this site. I have about 82 questions to ask you thus far, and here is one (in no particular order):

One line of code that I've seen you use in the CommandBars OnUpdate routines you use is (as noted above):

Application.CommandBars.FindControl(ID:=2040).Enabled = Not Application.CommandBars.FindControl(ID:=2040).Enabled

I've checked which commandbar that is (Share Workbook), and I'm curious as to why you: (1) use this button; and (b) toggle it on each run of the OnUpdate cycle.
Many thanks for all your great work. 81 questions (so far) to go....

 

[Jaafar Tribak]

Hi @Jaafar Tribak - I'm finally getting around to working my way through all your different code samples you've kindly uploaded onto this site. I have about 82 questions to ask you thus far, and here is one (in no particular order):

One line of code that I've seen you use in the CommandBars OnUpdate routines you use is (as noted above):

Application.CommandBars.FindControl(ID:=2040).Enabled = Not Application.CommandBars.FindControl(ID:=2040).Enabled

I've checked which commandbar that is (Share Workbook), and I'm curious as to why you: (1) use this button; and (b) toggle it on each run of the OnUpdate cycle.
Many thanks for all your great work. 81 questions (so far) to go....

Hi Dan

1) The idea of using that particular button was just because it is kind of rarely used so I thought enabling\disabling it is less likely to be noticed by the user but you could use any other commandbar button as long as you apply to it something to trigger the CommandBars OnUpdate event.
In fact, anything that triggers an update of the commandbars besides altering commandbar uttons should also work. Take a look a this ;

Option Explicit

Private WithEvents CBars As CommandBars

Private Sub Workbook_Open()
    Set CBars = Application.CommandBars
End Sub

Private Sub CBars_OnUpdate()
    Application.DisplayFullScreen = Application.DisplayFullScreen
    Debug.Print Now
End Sub

As you can see, updating the DisplayFullScreen Property is enough to trigger the commandbars OnUpdate event without changing anything at all which comes in very handy to emulate a timer, albeit slow.

2) I toggle it on each run of the OnUpdate cycle in order to perpetuate the OnUpdate event , otherwise the event will run only when physically interacting with the application UI such as when selecting a celll, resizing the application window, switching between sheets etc .

As I said, the idea is to emulate a slow timer (runs approx every 1/3 of a sec) whenever possible without needing to resort to the heavier and riskier win32 api timers.

Now, since this pseudo-timer is slow, I only use it when it is fast enough to accomplish the tasks I want.

EDIT;
Note that another defect of using this as an alternative timer is the fact that it is not asynchronous.