User inserting pictures in excel with macro - image

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

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

Answer 2

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