Inserting Picture into Merged Cells

[jmiller152]

I am trying to insert a picture into a selected merged cell. The code I am using the following code, but it only puts the picture in the small single cell and not the full merged cells. Thank you for your help.

Sub InsertPictures()
'Update 20140513
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
    xRowIndex = Application.ActiveCell.Row
    For lLoop = LBound(PicList) To UBound(PicList)
        Set Rng = Cells(xRowIndex, xColIndex)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        xRowIndex = xRowIndex + 1
    Next
End If
End Sub

 

[Logit]

Here is one resource .. not tested here. The OP states it is an answer to pasting an image to single and merged cells.

Inserting picture using macro vba to adopt to a merged cell or single cell

Another resource :

How to scale image to fit inside a merged cell?


But ... MERGED CELLS always create problems for the coder. The basic rule is to avoid using merged cells all together.

 

[jmiller152]

Or is there a way to use the code to resize the picture instead of filling the cell?

 

[Michael M]

Maybe something like this from Dave Hawley

Sub FitImageToCell()
With Sheet1.Shapes("Picture 1")
.Left = .TopLeftCell.Left
.Top = .TopLeftCell.Top
.Height = .TopLeftCell.Height
.Width = .TopLeftCell.Width
End With
End Sub