Inserting Picture into Merged Cells

jmiller152

New Member
Joined
May 1, 2020
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
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.

VBA Code:
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
 

Some videos you may like

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

jmiller152

New Member
Joined
May 1, 2020
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
Or is there a way to use the code to resize the picture instead of filling the cell?
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,491
Office Version
  1. 2013
Platform
  1. Windows
Maybe something like this from Dave Hawley
VBA Code:
Sub FitImageToCell()
With Sheet1.Shapes("Picture 1")
.Left = .TopLeftCell.Left
.Top = .TopLeftCell.Top
.Height = .TopLeftCell.Height
.Width = .TopLeftCell.Width
End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,118,807
Messages
5,574,425
Members
412,591
Latest member
dawnkotzebue
Top