Sub Insert_2_Images()
Dim rng As Range, wsh As Worksheet
Dim sFileName As String
Dim sFileName2 As String
Dim wia As Object
Dim PicWd As Double
Dim PicHt As Double
Dim xpicturesize As Double
Dim ypicturesize As Double
Dim Image As String
Dim Image2 As String
Dim Proportion As Double
Dim Proportion2 As Double
Dim ScaleX As Double
Dim ScaleY As Double
Range("B20:I20").Select 'Both pictures to be inserted will have the same size
For Each cell In Selection.Cells.Columns(1)
ypicturesize = ypicturesize + cell.Height
Next cell
For Each cell In Selection.Cells.Rows(1)
xpicturesize = xpicturesize + cell.Width
Next cell
Image = Range("AB3").Value 'name and location picture1
Image2 = Range("AB4").Value 'name and location picture2
Set wia = CreateObject("WIA.ImageFile")
wia.LoadFile Image
PicWd = wia.Width
PicHt = wia.Height
Proportion = PicWd / PicHt
Proportion2 = xpicturesize / ypicturesize
ScaleX = PicWd / xpicturesize
ScaleY = PicHt / ypicturesize
If Proportion < Proportion2 Then
PicWd = PicWd / ScaleY
PicHt = PicHt / ScaleY
Else
PicWd = PicWd / ScaleX
PicHt = PicHt / ScaleX
End If
Set wia = Nothing
Set rng = Range("B20:I20") 'merged cells where picture1 should fit in
rng.Select
Set wsh = rng.Parent
sFileName = Image
'Insert picture 1
wsh.Shapes.AddPicture sFileName, msoFalse, msoTrue, _
rng.Left, rng.Top, PicWd, PicHt
Range("AB3").Value = ""
Set rng2 = Range("L20:R20") 'merged cells where picture2 should fit in
rng2.Select
Set wsh2 = rng2.Parent
sFileName2 = Image2
'Insert picture 2
wsh2.Shapes.AddPicture sFileName2, msoFalse, msoTrue, _
rng2.Left, rng2.Top, PicWd, PicHt
Range("AB4").Value = ""
End Sub