Mouseover image

[IGORR]

HI:

I have a table with one column with the path of some images (B)

I would like when I put the mouse over one cell of a column (A), that show the image of the path of the column B, but when I move the mouse from the cell close the image.

I have one example but it only works for one excell.I would like to modify it to use for one complete column. If I put the mouse in A1 open the image of the path that it is in B1, the same for A2 and B2,.....

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Address = "$C$1" Then
ActiveSheet.Pictures.Insert("C:\Documents and Settings\Administrator\My Documents\My Pictures\Sample.jpg").Select
End If
End Sub

I need:

1) Covert it in an mouseover.
2) Work by ranges

Could you help me?

Thanks in advance

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

The main problem with your request is that worksheets do not support MouseOver events. Consequently, there is no obvious way to do this. However, several objects do support mouseovers e.g. buttons, charts and forms but each one had some kind of problem. Buttons, for instance, change transparency if clicked and there is a shadow you can't eliminate.

So I ended up with what is basically a trick which I discovered here some time ago: Interactive Dashboard in Excel using Hyperlinks | Chandoo.org - Learn Microsoft Excel Online

The problem with such a trick is that you cannot be sure how long it will remain working in Excel. Microsoft may do things a different way in the next version (I am using 2013).

It works like this. You enter a hyperlink in a cell but instead of linking to somewhere you link to a macro instead. When you hover over the ling the macro runs. So that was OK to display a picture but how do you stop displaying it. The only way I could think of was to surround the hyperlink cells with a rind of other hyperlinks that deleted the picture.

As a result, this method uses three columns that need to be full of text. That is, no blank spaces in the cells. The mouseover does not work on blank space. However, you can make the text the same colour as the cell background to hide it.

Two macros are required: one to display the picture and one to delete it. As several pictures can be drawn I delete them prior to drawing and also when the mouse moves out of the area.

To save the AddPicture command being run repeatedly as the mouse moves I check to see if a new cell has been selected. If it has not then the picture is not redrawn. That makes use of a Module-wide variable called LastCell which remembers the last cell that caused a macro to run.

Here are the two macros:

Dim LastCell As String

Public Function MyMouseOverEvent1()
    Dim ThisCell As String
    Dim shp As shape
    Dim myPic As shape
    ThisCell = Application.Caller.Address
    If LastCell <> ThisCell Then
        LastCell = ThisCell
        With ActiveSheet
            For Each shp In .Shapes
                If shp.Name = "myPic" Then shp.Delete
            Next
            Set myPic = .Shapes.AddPicture(.Range(ThisCell).Offset(0, 2).Value, msoCTrue, msoFalse, 250, 100, -1, -1)
            myPic.Name = "myPic"
        End With
    End If
End Function

Public Function MyMouseOverEvent2()
    Dim ThisCell As String
    Dim shp As shape
    ThisCell = "Finished"
    If LastCell <> ThisCell Then
        LastCell = ThisCell
        With ActiveSheet
            For Each shp In .Shapes
                If shp.Name = "myPic" Then shp.Delete
            Next
        End With
    End If
End Function

Excel 2013
	A	B	C	D
1	XXXXXXXX	XXXXXXXX	XXXXXXXX
2	XXXXXXXX	XXXXXXXX	XXXXXXXX	C:\Users\RickXL\Pictures\Doggies\Picture 029.jpg
3	XXXXXXXX	XXXXXXXX	XXXXXXXX	C:\Users\RickXL\Pictures\Doggies\Picture 039.jpg
4	XXXXXXXX	XXXXXXXX	XXXXXXXX	C:\Users\RickXL\Pictures\Doggies\Picture 068.jpg
5	XXXXXXXX	XXXXXXXX	XXXXXXXX	C:\Users\RickXL\Pictures\Doggies\Picture 070.jpg
6	XXXXXXXX	XXXXXXXX	XXXXXXXX	C:\Users\RickXL\Pictures\Doggies\Picture 074.jpg
7	XXXXXXXX	XXXXXXXX	XXXXXXXX	C:\Users\RickXL\Pictures\Doggies\Picture 075.jpg
8	XXXXXXXX	XXXXXXXX	XXXXXXXX	C:\Users\RickXL\Pictures\Doggies\Picture 363.jpg
9	XXXXXXXX	XXXXXXXX	XXXXXXXX	C:\Users\RickXL\Pictures\Doggies\Picture 379.jpg
10	XXXXXXXX	XXXXXXXX	XXXXXXXX	C:\Users\RickXL\Pictures\Doggies\Picture 380.jpg
11	XXXXXXXX	XXXXXXXX	XXXXXXXX
Sheet3

Cell Formulas
Range	Formula
A1	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
A2	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
A3	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
A4	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
A5	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
A6	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
A7	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
A8	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
A9	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
A10	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
A11	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
B1	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
B2	=IFERROR(HYPERLINK(MyMouseOverEvent1(),"XXXXXXXX"),"XXXXXXXX")
B3	=IFERROR(HYPERLINK(MyMouseOverEvent1(),"XXXXXXXX"),"XXXXXXXX")
B4	=IFERROR(HYPERLINK(MyMouseOverEvent1(),"XXXXXXXX"),"XXXXXXXX")
B5	=IFERROR(HYPERLINK(MyMouseOverEvent1(),"XXXXXXXX"),"XXXXXXXX")
B6	=IFERROR(HYPERLINK(MyMouseOverEvent1(),"XXXXXXXX"),"XXXXXXXX")
B7	=IFERROR(HYPERLINK(MyMouseOverEvent1(),"XXXXXXXX"),"XXXXXXXX")
B8	=IFERROR(HYPERLINK(MyMouseOverEvent1(),"XXXXXXXX"),"XXXXXXXX")
B9	=IFERROR(HYPERLINK(MyMouseOverEvent1(),"XXXXXXXX"),"XXXXXXXX")
B10	=IFERROR(HYPERLINK(MyMouseOverEvent1(),"XXXXXXXX"),"XXXXXXXX")
B11	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
C1	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
C2	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
C3	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
C4	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
C5	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
C6	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
C7	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
C8	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
C9	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
C10	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")
C11	=IFERROR(HYPERLINK(MyMouseOverEvent2(),"XXXXXXXX"),"XXXXXXXX")

 

[Jaafar Tribak]

Hi Rick,
This Hyperlink trick is very neat and very handy .. I never knew you could run a macro this way .. I worked for me in excel 2007

When you hover over the ling the macro runs. So that was OK to display a picture but how do you stop displaying it. The only way I could think of was to surround the hyperlink cells with a rind of other hyperlinks that deleted the picture.

You could use a small loop to mimic a cell exit event

These are the emodifications I made to your code to make it work without the need for extra columns/hyperlinks

1 - Set the Number Format of the cells that will hold the hyperlinks in Column A to Customize > ";;;" (without the quotes) .. This step is so that the Cell contents remain hidden from view and appear blank to the user
2 - Insert the hyperlink formulaes in column A : =IFERROR(HYPERLINK(MouseOverEvent()),"")
3 - Insert the corresponding images PathNames in Column B
4 - Place the following code in a standard module :

Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
#Else
    Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long

#End If

Private ThisCell As Range
Private myPic As Shape

Public Sub MouseOverEvent()
    Set ThisCell = Application.Caller
    With ThisCell
        If myPic Is Nothing Then
            Set myPic = ActiveSheet.Shapes.AddPicture _
            (.Offset(0, 1).Value, msoCTrue, msoFalse, .Left, .Top, .Width, .Height)
            myPic.OnAction = "Dummy"
            Call MouseExit
        End If
    End With
End Sub

Private Sub Dummy()

End Sub

Private Sub MouseExit()
    Dim tPt As POINTAPI
    Do
        GetCursorPos tPt
        If TypeName(ActiveWindow.RangeFromPoint(tPt.x, tPt.y)) <> "Range" Then Exit Do
        If ThisCell.Address <> ActiveWindow.RangeFromPoint(tPt.x, tPt.y).Address Then Exit Do
        DoEvents
    Loop
    myPic.Delete
    Set myPic = Nothing
    Set ThisCell = Nothing
End Sub

This worked for me very well !

Thanks for teaching us something new

 

[RickXL]

Hi Jaafar,

Thanks very much for the feedback.

I tried out your code and it worked well except that it flashed the images on and off if you held the mouse over a cell. Is that something wrong with my set up or is it supposed to work that way?

Anyway, encouraged by your working demonstration of how to use one column I decided to see if I could improve my previous attempt based on your feedback. I kept your idea of showing the pictures in the cells of column A, too.

By the way, I never looked for a Windows way of finding the mouse position because I did not know about RangeFromPoint. So I am learning new things, too.

I followed up on your suggestion to make a small loop and used a time delay instead. It works fairly well for me but it has only been tried on one machine.

Option Explicit

    Private Type POINTAPI
        x As Long
        y As Long
    End Type
    
    #If VBA7 And Win64 Then
        Private Declare PtrSafe Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
        Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
    #Else
        Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
        Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    #End If
    
    Private objA As Object
    Private objB As Object

Public Sub MouseOverEvent()
    On Error GoTo err
    Dim tPt As POINTAPI
    Dim shp As shape
    
    If objA Is Nothing Then
        GetCursorPos tPt
        Set objA = ActiveWindow.RangeFromPoint(tPt.x, tPt.y)
    End If
    
    Sleep 200
    
    GetCursorPos tPt
    Set objB = ActiveWindow.RangeFromPoint(tPt.x, tPt.y)
    
    If objB Is Nothing Then
        Call Delete
    ElseIf TypeName(objB) = "Picture" Then
        ' Do Nothing
    ElseIf TypeName(objA) = "Picture" Then
        Call Delete
    ElseIf Intersect(objB, ActiveSheet.UsedRange, ActiveSheet.Columns(1)) Is Nothing Then
        Call Delete
    ElseIf objA.Address <> objB.Address Then
        Call Delete
        Call Display
    Else
        Call Display
    End If
    
    Set objA = objB
    Exit Sub
    
err:
    Debug.Print "Error in Event:"; err.Number; err.Description
End Sub

Private Sub Delete()
    Dim shp As shape
    For Each shp In ActiveSheet.Shapes: shp.Delete: Next
End Sub

Private Sub Display()
    With objB
        ActiveSheet.Shapes.AddPicture .Offset(0, 1).Value, msoCTrue, msoFalse, .Left, .Top, .Width, .Height
    End With
End Sub

The On Error command is probably not required but it was useful for debugging.

 

[Jaafar Tribak]

I tried out your code and it worked well except that it flashed the images on and off if you held the mouse over a cell. Is that something wrong with my set up or is it supposed to work that way?

I haven't experienced any flashing of the images when holding the mouse over the cell .. On the contrary, the whole process is very smooth .. I don't know, It could be the set up or related to the excel version

A couple of remarks about your last code :
- The Delete Macro indiscriminately deletes all shapes including any pre-existing shapes on the worksheet .. the code will need to be modified accordingly
- Say the mouse pointer is over cell (A1) and the image is displayed as expected .. Now if you move the mouse pointer above or to the left of A1 (ieutside the cells area) the image remains there and is not deleted

 

[RickXL]

Thanks again.

I have already corrected the delete all macro in my copy of the macro. It now only deletes myPics.

Moving the cursor off the right hand side is a bit problematic. It is speed related. The sleep time needs to be long enough to catch the pointer after it has moved out of the area.

I think I can make it much simpler when my brain finally clicks into gear.

I will re-try your macro and see if I can find out why I get flashing. (One version of mine flashed because RangeFromPoint seemed to be identifying a point off the picture as a picture. I had moved the picture display into column B.)