Double click a cell to show a picture from a link in excel with VBA

user_13703896 0
Viewed 1131

I have the following function that will display a picture if you run your mouse over it. It's quite neat and works well. However, I'd like to change it from running your mouse over it to a double click function.

Below is the code that works that will show a picture when you run a mouse over a cell:

Dim DoOnce As Boolean
Public Function OnMouseOver(URL As String, TheCell As Range)

DoOnce = True
    With ActiveSheet.Pictures.Insert(URL)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = 570
            .Height = 380
        End With
        .Left = Cells(TheCell.Row, TheCell.Column + 1).Left
        .Top = Cells(TheCell.Row, TheCell.Column + 1).Top
        .Placement = 1
        .PrintObject = True
    End With
End Function

And I know I need the below code, of sorts, that if you double click on it something will happen:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$A$1" Then
        'do something
    End If
    Cancel = True
End Sub

I just can't seem to merge the two - so that I get the functionality of the original code, but with needing a double click rather than just passing the mouse over the cell.

The initial code references a concatenated picture lookup address in for pictures on my computer in sequential order for a process. I copy new links with the formula as more pictures are generated, which is quick, simple, and easy, and is why I want to keep the "OnMouseOver" function of the initial code, so I can copy this easily to new cells. I just want to action to reveal the pictures to be a double click, and not running the mouse over the cells as it currently works.

It would be a big help if I could get a hand with this.

Thanks,

Steve

vba excel
2 Answers

As "Double Click" enters into the editing of the excel cell, it may cause undesired edit of existing values/ formulas. So, I would recommend Worksheet_SelectionChange event. You can use it with navigation/ arrow keys as well.

Paste the following code in VBA - relevant "Sheet" Object

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim url As String

On Error Resume Next 'to avoid error if the target cell does not have url
'Even if we can use URLExists function to avoid such error,
'there will still be errors when there is value but not recognised by the function.
'For example an error caused by function =100/0

ActiveSheet.Pictures.Delete

'If URLExists(Target.Value) Then
'As we are using "on error resume next statement we don't need this.
'here is a link to this function
'https://stackoverflow.com/a/25428811/9808063

url = Target.Value

With Me.Pictures.Insert(url)
    With .ShapeRange
        .LockAspectRatio = msoTrue
        .Width = 300
        .Height = 200
    End With
    .Left = Cells(Target.Row + 2, Target.Column + 1).Left
    .Top = Cells(Target.Row + 2, Target.Column + 1).Top
    .Placement = 1
    .PrintObject = True
End With
'End If
End Sub
user_98080630
user_137038960
Related