Macro for Inserting Picture to Cell

[WingSystems]

Hey all,

I've been looking high and low on this site and others for help with a Macro I am trying to write and looking for some tips.

I am looking to do these things:
1. Click CommandButton
2. Pull up the insert picture dialogue
3. Have picture selected inserted to specific cell

It seems there are several solutions for inserting pictures when specifying a path...but I'm unable to find any that allow you to pull up the insert picture dialogue/file explorer and then let you input to a specific cell.

Any help is greatly appreciated.

 

[Sunny Kow]

Re: Help with Macro for Inserting Picture to Cell

Hi try this code given by RickXL given in one of the posts here.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim strFileSelected  As String
    'Insert picture in column A
    If Target.Count = 1 And Target.Column = 1 Then
        With Application.FileDialog(msoFileDialogFilePicker)
            .AllowMultiSelect = False
            .Filters.Clear
            .Filters.Add "JPEG File", "*.jpg"
            .Filters.Add "PNG File", "*.png"
            .Title = "Select Image"
            .Show
            If .SelectedItems.Count Then
                strFileSelected = .SelectedItems(1)
            Else
                MsgBox "Cancelled by user!"
                Exit Sub
            End If
        End With
        With Me.Pictures.Insert(strFileSelected)
            .ShapeRange.LockAspectRatio = False
            .Top = Target.Top
            .Left = Target.Left
            .Width = Target.Width
            .Height = Target.Height
            .Placement = xlMoveAndSize
        End With
    End If
End Sub

 

[tonyyy]

Re: Help with Macro for Inserting Picture to Cell

A similar approach, but without the Column A restriction...

Sub InsertPicture1()

Dim fName As String
Dim pic As Picture
Dim r As Range

fName = Application.GetOpenFilename( _
    FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
    Title:="Please select an image...")
If fName = "False" Then Exit Sub

Set r = ActiveCell 'This line sets the ActiveCell as the Target for insertion of the picture
Set pic = Worksheets("Sheet1").Pictures.Insert(fName)

With pic
    .ShapeRange.LockAspectRatio = msoTrue 'This line locks the ratio of Width to Height if =msoTrue, no distortion
    .Left = r.Left 'The  ' .Left=' and ' .Top=' in this and the next line set the respective locations for the placement of the picture
    .Top = r.Top
    '.Width = r.Width 'You can put an single quote before this line if you want to hold just the Height of the picture to be the height of the cell where it will be placed
    .Height = r.Height            'You can put an single quote before this line if you want to hold just the Width of the picture to be the width of the cell where it will be placed
End With

End Sub

Cheers,

tonyyy

 

[WingSystems]

Re: Help with Macro for Inserting Picture to Cell

Many thanks! I was able to modify this code to my needs by changing the ActiveCell to the specific cell.

A similar approach, but without the Column A restriction...

Sub InsertPicture1()

Dim fName As String
Dim pic As Picture
Dim r As Range

fName = Application.GetOpenFilename( _
    FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
    Title:="Please select an image...")
If fName = "False" Then Exit Sub

Set r = ActiveCell 'This line sets the ActiveCell as the Target for insertion of the picture
Set pic = Worksheets("Sheet1").Pictures.Insert(fName)

With pic
    .ShapeRange.LockAspectRatio = msoTrue 'This line locks the ratio of Width to Height if =msoTrue, no distortion
    .Left = r.Left 'The  ' .Left=' and ' .Top=' in this and the next line set the respective locations for the placement of the picture
    .Top = r.Top
    '.Width = r.Width 'You can put an single quote before this line if you want to hold just the Height of the picture to be the height of the cell where it will be placed
    .Height = r.Height            'You can put an single quote before this line if you want to hold just the Width of the picture to be the width of the cell where it will be placed
End With

End Sub

Cheers,

tonyyy

 

[tonyyy]

Re: Help with Macro for Inserting Picture to Cell

You're welcome. Glad that worked out for you.