User inserting pictures in excel with macro

Question

I'm a bit stuck on this one, since I couldn't find much on the web. Basically, I'd like the user to be able to click a button which formats some cells, and then opens a box which makes the user navigate through windows explorer in order to insert one or two pictures in the newly formatted cells.

This is what I have so far:

Private Sub AddPic_Click()
    Dim lastCell As Range
    Dim newCell1 As Range
    Dim newCell2 As Range
    Dim newCellMergePic1 As Range
    Dim newCellMergePic2 As Range
    Dim myRange As Range

    Set myRange = Worksheets("Product Packaging").Range("A1:A1000")

    For Each r In myRange
        If r.MergeCells Then
            Set lastCell = r
        End If
    Next r

    Set newCell1 = lastCell.Offset(1, 0)
    Set newCell2 = newCell1.Offset(0, 5)

    Set newCellMergePic1 = Range(newCell1, newCell1.Offset(9, 4))
    Set newCellMergePic2 = Range(newCell2, newCell2.Offset(9, 4))

    newCellMergePic1.Merge
    newCellMergePic2.Merge

    With newCellMergePic1
        .Font.Name = "Calibri"
        .Font.Color = vbBlack
        .VerticalAlignment = xlVAlignCenter
        .HorizontalAlignment = xlHAlignCenter
        .Font.Bold = True
        .Value = "Picture Here"
    End With

    With newCellMergePic2
        .Font.Name = "Calibri"
        .Font.Color = vbBlack
        .VerticalAlignment = xlVAlignCenter
        .HorizontalAlignment = xlHAlignCenter
        .Font.Bold = True
        .Value = "Picture Here"
    End With
End Sub

It works, but I don't know how to integrate the feature which allows the user to navigate through their folders in order to select the picture(s) they want to add. Thank you for the taking the time to read my post.

Answer 1

Problem solved, here is the final result

Private Sub AddPic_Click()

Dim lastCell As Range

Dim newCell1 As Range
Dim newCell2 As Range

Dim newCellMergePic1 As Range
Dim newCellMergePic2 As Range

Dim myRange As Range

Dim fd As Office.FileDialog

Dim Pic1 As Picture
Dim Pic2 As Picture

Dim Pic1Path As String
Dim Pic2Path As String

Set fd = Application.FileDialog(msoFileDialogFilePicker)

Set myRange = Worksheets("Product Packaging").Range("A1:A1000")

For Each r In myRange
    If r.MergeCells Then
        Set lastCell = r
    End If
Next r

Set newCell1 = lastCell.Offset(1, 0)
Set newCell2 = newCell1.Offset(0, 5)

Set newCellMergePic1 = Range(newCell1, newCell1.Offset(9, 4))
Set newCellMergePic2 = Range(newCell2, newCell2.Offset(9, 4))

newCellMergePic1.Merge
newCellMergePic2.Merge

With newCellMergePic1
    .Font.Name = "Calibri"
    .Font.Color = vbBlack
    .VerticalAlignment = xlVAlignCenter
    .HorizontalAlignment = xlHAlignCenter
    .Font.Bold = True
    .Value = "Picture Here"
End With

With newCellMergePic2
    .Font.Name = "Calibri"
    .Font.Color = vbBlack
    .VerticalAlignment = xlVAlignCenter
    .HorizontalAlignment = xlHAlignCenter
    .Font.Bold = True
    .Value = "Picture Here"
End With

With fd

    .AllowMultiSelect = True
    .Title = "Please select picture(s). Maximum of two pictures per insert."
    .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1

    If .Show = True Then

        If .SelectedItems.Count > 2 Then

            MsgBox "Please select no more than 2 pictures at once.", vbExclamation, Conflict

                        Dim delRange1 As Excel.Range
                        Dim delRange2 As Excel.Range

                        Set myRange = Worksheets("Product Packaging").Range("A1:A1000")

                        For Each r In myRange
                            If r.MergeCells Then
                                Set lastCell = r
                            End If
                        Next r

                        If lastCell.Address <> Range("A2").Address Then

                            Set lastCell2 = lastCell.Offset(0, 5)

                            Set delRange1 = lastCell.MergeArea
                            Set delRange2 = lastCell2.MergeArea

                            delRange1.ClearContents
                            delRange2.ClearContents

                            lastCell.UnMerge
                            lastCell2.UnMerge

                            Exit Sub

            End If

        End If


        Pic1Path = .SelectedItems(1)

        Set Pic1 = Pictures.Insert(Pic1Path)

        With Pic1.ShapeRange
            .LockAspectRatio = msoTrue
            .Height = newCellMergePic1.Height - 2
            .Top = newCellMergePic1.Top + 1
            .Left = newCellMergePic1.Left
        End With

        If .SelectedItems.Count = 2 Then
            Pic2Path = .SelectedItems(2)
            Set Pic2 = Pictures.Insert(Pic2Path)

            With Pic2.ShapeRange
                .LockAspectRatio = msoTrue
                .Height = newCellMergePic2.Height - 2
                .Top = newCellMergePic2.Top + 1
                .Left = newCellMergePic2.Left
            End With

        End If

    End If

End With

End Sub

Answer 2

You will need to use a dialog box:

Option Explicit

Public Sub addImage1()
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .ButtonName = "Ok"
        .Title = "Select an image"
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "JPEG File Interchange Format", "*.JPEG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "All Pictures", "*.*"
        If .Show = -1 Then
            Dim img As Object
            Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1))
        Else
            MsgBox ("Cancelled.")
        End If
    End With
End Sub

or

Public Sub addImage2()
    Dim result, imgTypes As String

    imgTypes = imgTypes & "JPG files (*.jp*),*.jp*"
    imgTypes = imgTypes & ", GIF files (*.gif),*.gif"
    imgTypes = imgTypes & ", PNG files (*.png),*.png"
    imgTypes = imgTypes & ", All files (*.*),*.*"

    result = Application.GetOpenFilename(imgTypes, 1, "Select Image", , False)

    If result <> False Then
        ActiveSheet.Pictures.Insert (result)
    End If
End Sub