Centre and scale image inserted into merged cells

[alexg7828]

Hi,

I am using the below macro to insert images into a group of merged cells, it works perfectly however i would also like it to automatically scale and centre the image to fit in the merged cells... Any ideas ?

Thanks in advance Alex

Sub InsertImageBox1()
Dim FName$
With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = [a67]                    ' path from cell
    .Filters.Clear
    .Filters.Add "JPEGS", "*.jpg; *.jpeg"
    .Filters.Add "GIF", "*.GIF"
    .Filters.Add "Bitmaps", "*.bmp"
    .AllowMultiSelect = 0
    If .Show = True Then
        FName = .SelectedItems(1)
    Else
        MsgBox "Operation Cancelled"
        Exit Sub
    End If
End With
ActiveSheet.Pictures.Insert (FName)
End Sub

 

[alexg7828]

I have trawled through posts on here and found something that looks similar to what i want to do but not sure how to implement it with the first part of my code, credit to BiocideJ for the below (not sure if i need to reference the post or something else on here...)

Sub FIT_IMG_TO_RNG()
'Set CellLoc as the cell that you want to fit the image into or any cell within the merged area you wish to place the image
Set CellLoc = Range("A1")
PictureFileName = "[URL="https://www.mrexcel.com/forum/redirect-to/?redirect=http%3A%2F%2Fwww.google.com%2Flogos%2Fdoodles%2F2015%2Fbeethovens-245th-birthday-4687587541254144-hp.jpg"]http://www.google.com/logos/doodles/...1254144-hp.jpg[/URL]"
    Set p = CellLoc.Parent.Pictures.Insert(PictureFileName)
    
    p.Left = CellLoc.MergeArea.Left
    p.Top = CellLoc.MergeArea.Top
    
    If p.Width > CellLoc.MergeArea.Width Then p.Width = CellLoc.MergeArea.Width
    If p.Height > CellLoc.MergeArea.Height Then p.Height = CellLoc.MergeArea.Height
    'Center
        
    If p.Width < CellLoc.MergeArea.Width Then p.Left = CellLoc.MergeArea.Left + (CellLoc.MergeArea.Width - p.Width) / 2
    If p.Height < CellLoc.MergeArea.Height Then p.Top = CellLoc.MergeArea.Top + (CellLoc.MergeArea.Height - p.Height) / 2
End Sub