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.