Using VBA to open Insert picture from file on Double click

[lengyel109]

Hi everyone!

I ran into some trouble trying to open the insert picture from file dialog box when double clicking a specific cell and then inserting the selected picture into the double clicked cell.
I was able to get a basic code working where if you double click a cell in a range, then gives you a msgBox with "Insert Picture" text.

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Selection.Count = 1 Then
        If Not Intersect(Target, Range("F10:F28")) Is Nothing Then
            'Only for testing to see if it works
            MsgBox "Insert Picture"
       End If
       Cancel = True
    End If
End Sub

Here comes the part where I just cannot find a working solution. Instead of giving the MsgBox I would like the Insert Picture from File dialog box to open, where I could select what I want to Insert and then insert the picture to the said cell. Later on I would think of resizing the pictures as well, but for now if this starts working, I could proceed to the next obstacle.

Any ideas? Or am I expecting something that would not work the way I want it?
Thanks in advance,
Mark

 

[BenMcBen]

So as far as inserting a picture pls see How to insert a picture into Excel at a specified cell position with VBA

You can pimp this up by using something like:

VBA Select Files with msoFileDialogFilePicker - wellsr.com

 

[lengyel109]

So as far as inserting a picture pls see How to insert a picture into Excel at a specified cell position with VBA

You can pimp this up by using something like:

VBA Select Files with msoFileDialogFilePicker - wellsr.com

Unfortunately the first link was too advanced for me I think so it was more or less gibberish, but Insert an image into a worksheet did the job what I was looking for plus resizes the image as well.
The second link was pretty straight forward, so thank you for that.

Also, I expanded the code with a function where it resizes the picture to the double clicked cell. But for that I needed this VBA Code To Measure Selected Cell Range Height & Width In Pixels code as well.

I'm not sure if this is the most elegant way to go about it, but here's the code if anyone needs it.

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'For getting the path as a string
Dim strFilePath As String
'For Inserting the picture
Dim ws As Worksheet
Dim imagePath As String
Dim imgLeft As Double
Dim imgTop As Double
'For measurements
Dim cell As Range
Dim cellWidth As Long
Dim cellHeight As Long

    'Selection from the range where pictures should be placed
    If Selection.Count = 1 Then
        If Not Intersect(Target, Range("F10:F28")) Is Nothing Then
            
            'Measure Selection Height
            For Each cell In Selection.Cells.Columns(1)
            cellHeight = cellHeight + cell.Height
            Next cell
            'Measure Selection Width
            For Each cell In Selection.Cells.Rows(1)
            cellWidth = cellWidth + cell.Width
            Next cell
            'Report Results - FOR TESTING
            'MsgBox "Height:  " & cellHeight & "px" & vbCr & "Width:   " _
            & cellWidth & "px", , "Dimensions"
            
            'Select filepath from selection dialog
            With Application.FileDialog(msoFileDialogFilePicker)
                If .Show <> 0 Then
                'Set path to selected item
                strFilePath = .SelectedItems(1)
                'Show path - FOR TESTING
                'MsgBox "Insert Picture " & strFilePath
                
                Set ws = ActiveSheet
                imagePath = strFilePath
                imgLeft = ActiveCell.Left
                imgTop = ActiveCell.Top
                
                'Insert and resize picture to cell size+ a small border
                ws.Shapes.AddPicture _
                Filename:=imagePath, _
                LinkToFile:=msoFalse, _
                SaveWithDocument:=msoTrue, _
                Left:=imgLeft + 2, _
                Top:=imgTop + 1, _
                Width:=cellWidth - 2, _
                Height:=cellHeight - 3
                
                End If
            End With
        End If
    End If
    'Cancel double clicked cell
    Cancel = True
End Sub