Hover over cell to display a NON comment dynamic external image

[spongebob]

Hello All,

I have seen a few things referencing a comment and filling it with a picture, but that unfortunately isn't dynamic.
Then I have seen some outdated vba code (just older posts on the web) showing a way to accomplish it, but not finding one that works.

What I would like to do is define a folder name, then grab values from a column and then from each cell, display an external image.

An example would be:
Column A has Pic name, Column 2 shows the year it was made.
In the first data row, you have the name of the picture, so the path would be built like concatenate("c:\common-Path\",a2,".jpg")
In this example it's 1.jpg
Now if I hover over the one, I would like to display the image.
Any suggestions appreciated!

PIC#	Year
1​	2005​
2​	2019​
3​	2005​
4​	2009​
5​	2005​
6​	2005​
7​	2016​
8​	2016​
9​	2016​
10​	2010​
11​	2010​

 

[edmitchell]

Hi,

My proposed solution consists of a few formulae, plus some VBA, so if in your grid, "A1" = "PIC, and "B1"="Year" the additions would be :-

Cell	Contents
C2	=IFERROR(HYPERLINK(Hover(A2),A2),A2)
C3	=IFERROR(HYPERLINK(Hover(A3),A3),A3)
C4,5,6, etc	(pasted copies of the above, e.g. referencing "A4", "A5", etc )
E1 (e.g. an unused cell)	=Get_IMAGE(E2,H1:P25)
E2	(empty) updated by the Function "Hover" as shown below, and referenced by the GET_Image function in "E1"
E3	=E2 used by the Function "Hover" to see if the Image has changed, since last run (without this, when the mouse hover's over the value in Column "C" the image 'refresh' repeats unnecessarily)
H1 : P25	would be where the image is shown (may need to increase the range as needed), and the reference in "E1" would also need changing to this new range

(cells E1/E2/E3 could obviously have their font to a white color so the contents would not be visible, etc

VBA would be:-

Public Function Hover(C As Range)

    Dim New_Image As String
    
    New_Image = "C:\temp\pictures\" & C.Value & ".jpg"                                  'Default folder, and all Images have an "JPG" extension
    
    'If the "check" cell, already has the value we are potentially changing to, then do nothing (as nothing has changed!)
    If (New_Image = Sheet1.Range("e3").Value) Then
    Else
        Sheet1.Range("e2") = New_Image  'set cell "E2" to the location & name of the new image to display..
                                        '"E2" is referenced in the formula in "E1" which contains the reference to the Get_Image function
    End If
    
End Function




Public Function Get_IMAGE(FilePath As String, Location As Range)

'Parameters are:-
' FilePath = location of the reference to the new image (full path, file name, and extension)
'Location = Range where we are to display the image

Dim Our_sheet As String, Image As Shape, Name_of_Image As String

Name_of_Image = "Image"
Our_sheet = Location.Parent.Name

'If it exists remove the current picture
For Each Image In Sheets(Our_sheet).Shapes
    If Image.Name = Name_of_Image & "1" Then
        Image.Delete
    End If
Next Image

'Add Image in the right location
Set Image = Sheets(Our_sheet).Shapes.AddPicture _
(FilePath, msoFalse, msoTrue, Location.Left, Location.Top, -1, -1)

'Resize Image if needed
If Location.Width / Location.Height > Image.Width / Image.Height Then
    Image.Height = Location.Height
Else
    Image.Width = Location.Width
End If

'Update the name of the image (which we will used next time function runs)
Image.Name = Name_of_Image & "1"

Get_IMAGE = "IMAGE: "

End Function

I hope it works for you (the test file I have seems to do what you described)

Enjoy!

 

[spongebob]

This worked like a charm, thank you very much for your help!!!

 

[spongebob]

I have a question in respect to making the image display in the middle of the screen per se. in relation to the row you are on.
If you have defined lets say rows 1:10 then when you are row 30 and want to see the image from that row, it will display above the viewing area.

Also, when you aren't hovered over any image links, the last image stays there, is there a way for it to clear? I know I can delete the value in e2 and it will remove the image from view.

Thanks again!

 

[edmitchell]

Hi, re your second question (e.g. to clear the image), were you thinking of it clearing after a certain time, after pressing a button, or after another sort of event?

 

[spongebob]

If possible, after you mouse away, but a certain time could work as well, what is easiest?

 

[edmitchell]

How about, the user clicks on the Image (that had appeared after the 'hover'), and then Image 'vanishes' (would only need a small amount of additional VBA)?

 

[spongebob]

That would work, thank you very much!

 

[edmitchell]

Ok - the following changes are needed:-

Cell	New contents
E1	=Get_IMAGE(E2,H1:P25,F2)
F2	(empty) updated by the VBA Function "Hover" with the top position (in points) of the row where the 'hover' event took place. This then referenced by the GET_Image function in "E1", so that the top of the new image is positioned at the 'top' of that row.

Replacement VBA code

Public Function Hover(C As Range)
'C is effectively the name of the Image file

    ActionRow = C.Row 'get the row where we were called from
    Our_Sheet = C.Parent.Name 'what is the name of the Sheet where we are?
    
    Dim New_Image As String
    
    New_Image = "C:\temp\pictures\" & C.Value & ".jpg" 'Default folder, and all Images have an "JPG" extension
    
    'If the "check" cell already has the value we are potentially changing to, then do nothing (as nothing has changed!)
    If (New_Image = Sheet1.Range("e3").Value) Then
    Else
        Sheets(Our_Sheet).Range("e2") = New_Image  'set cell "E2" to the location & name of the new image to display..
                                        '"E2" is referenced in the formula in "E1" which contains the reference to the Get_Image function
        Sheets(Our_Sheet).Range("f2") = C.Top    'record which row we were called from, so Image top can be aligned here
    End If
    
End Function

Public Function Get_IMAGE(FilePath As String, Location As Range, Top_left As Double)

'Paramaters are:-
' FilePath = location of the reference to the new image (full path, file name, and extension)
'Location = Range where we are to display the image

Dim Our_Sheet As String, Image As Shape, Name_of_Image As String

Name_of_Image = "Image"
'Our_sheet = Location.Parent.Name
Our_Sheet = Location.Parent.Name

'If it exists remove the current picture
For Each Image In Sheets(Our_Sheet).Shapes
    If Image.Name = Name_of_Image & "1" Then
        Image.Delete
    End If
Next Image

'Add Image in the right location
Set Image = Sheets(Our_Sheet).Shapes.AddPicture _
(FilePath, msoFalse, msoTrue, Location.Left, Top_left, -1, -1)

'Resize Image if needed
If Location.Width / Location.Height > Image.Width / Image.Height Then
    Image.Height = Location.Height
Else
    Image.Width = Location.Width
End If

'Update the name of the image (which we will used next time function runs)
Image.Name = Name_of_Image & "1"
Image.OnAction = "Image1_click"     'set the onclick event to our subroutine..

Get_IMAGE = "IMAGE: "

End Function

Sub Image1_Click()
    Dim Our_Image As Shape, Our_Sheet As String
    
    Our_Sheet = Application.ActiveSheet.Name
    Set Our_Image = Sheets(Our_Sheet).Shapes("Image1")
    Our_Image.Delete
    
End Sub

The extra sub routine "Image1_Click" is actioned when the image is clicked, and removes the Image itself

 

[spongebob]

Looks a little confusing at first, but will plug in and test, thank you very much!