Pop Up Showing Image

E

excelakos

Board Regular
Joined
Jan 22, 2014
Messages
85
Hello to everyone and thank oy in advance. I hope that what I ask for is doable.
In a sheet (excel 2013) I keep a list of images belonging to specific folders.
As you could imagine I have copied the path of each image and then used the function HYPELINK(CELL) to turn them into clickable hyperlinks.
Now what I would like to get is a pop-up of the image when hovering around each cell.
Is such a feature achievable? To somehow use the link address of the hyperlink and get just a pop-up of the image file when hovering the cell??
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
Georgiboy said:
Below is an example of a workaround to fire a UDF when a hyperlink is hovered over.
Hover Over Hyperlink.xlsm
Click to expand...
Hey Georgiboy...Thank you for your time.
I got to the file and I try to apply the specific

Excel Formula: 
=HYPERLINK(MouseHover(D4);"Pic 1")

But no result...
I also noticed the code on the sheet

VBA Code: 
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Does the above play any part to the function etc???
 
Upvote 0
Georgiboy said:
Below is an example of a workaround to fire a UDF when a hyperlink is hovered over.
Hover Over Hyperlink.xlsm
Click to expand...
Just figured it out and ...... W-O-W!!!!!!!!!

We need

The code for the sheet
The module
The Form & the code for it

AMAZING!!!!!!!

tHANK YOU SO MUCH!!!

a couple of notes though

Can we make the form disappear after x seconds or/and force to close when hitting esc button???
 
Upvote 0
Another issue I notice is that when I need to enter new data in the table range I use (to add a new row, with image path, etc), the form pops up and keeps popping one image after the other forever..The only thing I can do is ask task manager to close the entire Excel (All Open Workbooks).

Is there any way to stop this ?
 
Upvote 0
excelakos said:
Another issue I notice is that when I need to enter new data in the table range I use (to add a new row, with image path, etc), the form pops up and keeps popping one image after the other forever..The only thing I can do is ask task manager to close the entire Excel (All Open Workbooks).

Is there any way to stop this ?
Click to expand...
I guess you are aware we can add pictures to cell comments. That would be much easier and cleaner than using the Hyperlink trick ... Obviously, adding pics to comments with would only work with static pictures as there is no built-in way of detecting when the mouse hovers over cells.

I am not sure which exact scenario you have.

Anyways, for dynamic pictures using the hyperlink approach, I have played around a bit with it and have come up with the following code.

This code should prevent the form from popping up repeatedly when inserting\deleting rows and it should also allow for dismissing the form when hitting the ESC key as requested.

Hover Over Hyperlink_API.xlsm






Place this code in a Standard Module:
VBA Code: 
Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top  As Long
    Right As Long
    Bottom As Long
End Type

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
    #End If
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
    Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
#End If
    
Private oPrevRange As Range, oForm As Object


Function MouseHover(ByVal imgFilePath As String)
    Dim tCurPos As POINTAPI
    Dim oCurObj As Range
    Dim hForm As LongPtr
    
    Set oForm = UserForm1
    oForm.PictureSizeMode = fmPictureSizeModeStretch
    Call IUnknown_GetWindow(oForm, VarPtr(hForm))
    On Error Resume Next
    Call GetCursorPos(tCurPos)
    Set oCurObj = ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)
    If oCurObj.Address <> oPrevRange.Address Then
        If Len(Application.Caller) Then
            If Len(Dir(imgFilePath)) Then
                Call KillTimer(Application.hwnd, 0&)
                Call SetTimer(Application.hwnd, 0&, 0&, AddressOf TimerProc)
                oForm.Picture = LoadPicture(imgFilePath)
                oForm.Show vbModeless
                Call HideCaption(hForm)
                Call PositionForm(hForm)
            End If
        End If
    End If
    Set oPrevRange = oCurObj
End Function

'_____________________________________________ Private Routines __________________________________________________

Private Sub TimerProc()
    Dim oCurObjx As Range
    Dim tCurPos As POINTAPI
    
    On Error Resume Next
    Call GetCursorPos(tCurPos)
    Set oCurObjx = ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)
    If GetAsyncKeyState(VBA.vbKeyEscape) Then
        Unload oForm
        Exit Sub
    End If
    
    If oCurObjx.Address <> oPrevRange.Address Then
        Call KillTimer(Application.hwnd, 0&)
        Set oPrevRange = Nothing
        Unload oForm
    End If
End Sub

Private Sub HideCaption(ByVal hwnd As LongPtr)
    Const GWL_STYLE = &HFFF0, WS_CAPTION = &HC00000
    Const GWL_EXSTYLE = (-20), WS_EX_DLGMODALFRAME = &H1&
    Dim Style As LongPtr
    
    Style = GetWindowLong(hwnd, GWL_STYLE)
    Style = Style And Not WS_CAPTION
    Call SetWindowLong(hwnd, GWL_STYLE, Style)
    Style = GetWindowLong(hwnd, GWL_EXSTYLE)
    Style = Style And Not (WS_EX_DLGMODALFRAME)
    Call SetWindowLong(hwnd, GWL_EXSTYLE, Style)
    Call DrawMenuBar(hwnd)
End Sub

Private Sub PositionForm(ByVal hwnd As LongPtr)
    Const SWP_NOSIZE = &H1
    Dim tRect As RECT
    Dim tCurPos As POINTAPI
    
    Call GetCursorPos(tCurPos)
    Call GetWindowRect(hwnd, tRect)
    With tCurPos
        Call SetWindowPos( _
             hwnd, -1, .x + 40&, .y - (tRect.Bottom - tRect.Top), _
             0&, 0&, 0 + 0 + SWP_NOSIZE _
        )
    End With
End Sub

Private Sub Auto_Close()
    Call KillTimer(Application.hwnd, 0&)
End Sub


Note: The UserForm is left blank with no controls and has no code behind it. Also, needless to say that will need to change the image files paths in cells D9 and D10 to suit your needs.

Regards.
 
Upvote 0
Solution
Jaafar Tribak said:
I guess you are aware we can add pictures to cell comments. That would be much easier and cleaner than using the Hyperlink trick ... Obviously, adding pics to comments with would only work with static pictures as there is no built-in way of detecting when the mouse hovers over cells.

I am not sure which exact scenario you have.

Anyways, for dynamic pictures using the hyperlink approach, I have played around a bit with it and have come up with the following code.

This code should prevent the form from popping up repeatedly when inserting\deleting rows and it should also allow for dismissing the form when hitting the ESC key as requested.

Hover Over Hyperlink_API.xlsm






Place this code in a Standard Module:
VBA Code: 
Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top  As Long
    Right As Long
    Bottom As Long
End Type

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
    #End If
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
    Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
#End If
   
Private oPrevRange As Range, oForm As Object


Function MouseHover(ByVal imgFilePath As String)
    Dim tCurPos As POINTAPI
    Dim oCurObj As Range
    Dim hForm As LongPtr
   
    Set oForm = UserForm1
    oForm.PictureSizeMode = fmPictureSizeModeStretch
    Call IUnknown_GetWindow(oForm, VarPtr(hForm))
    On Error Resume Next
    Call GetCursorPos(tCurPos)
    Set oCurObj = ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)
    If oCurObj.Address <> oPrevRange.Address Then
        If Len(Application.Caller) Then
            If Len(Dir(imgFilePath)) Then
                Call KillTimer(Application.hwnd, 0&)
                Call SetTimer(Application.hwnd, 0&, 0&, AddressOf TimerProc)
                oForm.Picture = LoadPicture(imgFilePath)
                oForm.Show vbModeless
                Call HideCaption(hForm)
                Call PositionForm(hForm)
            End If
        End If
    End If
    Set oPrevRange = oCurObj
End Function

'_____________________________________________ Private Routines __________________________________________________

Private Sub TimerProc()
    Dim oCurObjx As Range
    Dim tCurPos As POINTAPI
   
    On Error Resume Next
    Call GetCursorPos(tCurPos)
    Set oCurObjx = ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)
    If GetAsyncKeyState(VBA.vbKeyEscape) Then
        Unload oForm
        Exit Sub
    End If
   
    If oCurObjx.Address <> oPrevRange.Address Then
        Call KillTimer(Application.hwnd, 0&)
        Set oPrevRange = Nothing
        Unload oForm
    End If
End Sub

Private Sub HideCaption(ByVal hwnd As LongPtr)
    Const GWL_STYLE = &HFFF0, WS_CAPTION = &HC00000
    Const GWL_EXSTYLE = (-20), WS_EX_DLGMODALFRAME = &H1&
    Dim Style As LongPtr
   
    Style = GetWindowLong(hwnd, GWL_STYLE)
    Style = Style And Not WS_CAPTION
    Call SetWindowLong(hwnd, GWL_STYLE, Style)
    Style = GetWindowLong(hwnd, GWL_EXSTYLE)
    Style = Style And Not (WS_EX_DLGMODALFRAME)
    Call SetWindowLong(hwnd, GWL_EXSTYLE, Style)
    Call DrawMenuBar(hwnd)
End Sub

Private Sub PositionForm(ByVal hwnd As LongPtr)
    Const SWP_NOSIZE = &H1
    Dim tRect As RECT
    Dim tCurPos As POINTAPI
   
    Call GetCursorPos(tCurPos)
    Call GetWindowRect(hwnd, tRect)
    With tCurPos
        Call SetWindowPos( _
             hwnd, -1, .x + 40&, .y - (tRect.Bottom - tRect.Top), _
             0&, 0&, 0 + 0 + SWP_NOSIZE _
        )
    End With
End Sub

Private Sub Auto_Close()
    Call KillTimer(Application.hwnd, 0&)
End Sub


Note: The UserForm is left blank with no controls and has no code behind it. Also, needless to say that will need to change the image files paths in cells D9 and D10 to suit your needs.

Regards.
Click to expand...
Thank you Jaafar!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
Pop Up Message if specific cells are greater than other specific cells
Replies
5
Views
1K
tabs1063
T
W
  • Solved
pop up msgbox dependent on specific text entered into userform combobox
Replies
3
Views
549
Wishful Thinking
W
M
  • Question Question
Using a hyperlink to a Thumbs up if 100% is achieved. Or if not a thumbs down.
Replies
1
Views
335
RoryA
RoryA
RICH937
  • Solved
An easy one (hopefully) - How do I turn the formula pop up off?
2
Replies
11
Views
2K
felixstraube
F
G
  • Question Question
Macro to consolidate multiple worksheets into Master based on cell data?
Replies
1
Views
687
bobaol
B

Forum statistics

Threads
1,223,908
Messages
6,175,305
Members
452,633
Latest member
DougMo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top