Continued: Use VBA to show an image of cells in a pop up window

rokusek

New Member
Joined
May 6, 2022
Messages
6
Office Version
  1. 365
Hello all, first time posting here so I hope I'm doing this right...not a beginner with VBA but for some reason I am having a mental block here and can't figure this out for some reason. I found this bit posted by BiocideJ in 2014 in response to a question about needing an image of cells to pop up when double clicked like a tooltip of sorts. This code is awesome however it works all over the worksheet, I need it to work on a specific range, let's say A1. I have tried replacing the activesheet with a range and I've tried naming a range and calling it and it does not work...I hoping someone here can assist. TIA!

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ImgRange As Range
    'remove any picture images previously generated
    For Each Shape In ActiveSheet.Shapes
        If Left(Shape.Name, 7) = "Picture" Then
            Shape.Delete
        End If
    Next
    'pseudo-refresh window so partial image residuals don't show on screen
    Application.WindowState = Application.WindowState

    'You will need to set this range dynamically based on
[B]   Set ImgRange = Range("J5:L13")[/B]
   
    'shows the Range as it would display for printing.
    'Change xlPrinter to xlScreen to show as it appears on the screen
    ImgRange.CopyPicture xlPrinter, xlPicture
    
    ActiveSheet.Paste Destination:=Target.Offset(0, 1)
    
    With ActiveSheet.Shapes.Range(1)
        .Line.Visible = msoTrue
        .Line.ForeColor.RGB = RGB(100, 100, 100)
        .Line.Transparency = 0
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Fill.Transparency = 0
        .Fill.Solid
    End With
End Sub
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Try adding this line after the Dim Statement
VBA Code:
    If Target.Address(0, 0) <> "A1" Then Exit Sub
 
Upvote 0
If you want this to work only if you double-click A1, then add this line at the top:

VBA Code:
If Target.Address <> "$A$1" Then Exit Sub
 
Upvote 0
Y'all are awesome! It's getting there...I need it to disappear when clicking on another cell
 
Upvote 0
Glad we could help & thanks for the feedback.
 
Upvote 0
I moved the suggested code to after the for each shape in active sheet and changed it from a double click to a selectionchange and it works nicely however it then selects the image and instead of staying on the selected range...

I swear I'm not normally this lost but for some reason I can't brain too easily today lol
 
Upvote 0
You could add this to the end of the sub
VBA Code:
    Application.EnableEvents = False
    Range("A1").Select
    Application.EnableEvents = True
 
Upvote 0
thanks all for your help on this, I did some updating to the suggested code and here is the update...the only disadvantage I am seeing at this point is it runs a bit slow, I may just explore a hover over method with and activeX box, I just hate the idea of imbedding an object over data

VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim ImgRange As Range

    For Each Shape In ActiveSheet.Shapes
        If Left(Shape.Name, 7) = "Picture" Then
            Shape.Delete
        End If
    Next

    If Intersect(Target, Range("test")) Is Nothing Then Exit Sub

    Set ImgRange = Range("J5:K6")
   
    ImgRange.CopyPicture xlPrinter, xlPicture
    
    ActiveSheet.Paste Destination:=Target.Offset(0, 1)
    
    With ActiveSheet.Shapes.Range(1)
        .Line.Visible = msoTrue
        .Line.ForeColor.RGB = RGB(100, 100, 100)
        .Line.Transparency = 1
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Fill.Transparency = 1
        .Fill.Solid
    End With
    
    Application.EnableEvents = False
    Intersect(Target, Range("test")).Select
    Application.EnableEvents = True

End Sub
 
Upvote 0
Glad you sorted it & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,142
Members
448,551
Latest member
Sienna de Souza

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