'Load image to fit in merged cell

I have a table that contains the file path, when the button is clicked the macro will display an image according to the url path. Here is my code (sourch : Link)

Sub Macro_1()
Dim cShape As Shape
Dim cRange As Range
Dim cColumn As Long
On Error Resume Next
Application.ScreenUpdating = False
Set xRange = ActiveSheet.Range("C5:D6, G5:H6, C8:D9, G8:H9")
For Each cell In xRange
    cName = cell
    ActiveSheet.Pictures.insert(cName).Select
    Set cShape = Selection.ShapeRange.Item(1)
    If cShape Is Nothing Then GoTo line22
    cColumn = cell.Column
    Set cRange = Cells(cell.Row, cColumn)
    With cShape
          .LockAspectRatio = msoFalse
            .Height = cRange.Height - 5
            .Width = cRange.Width - 5
            .Top = cRange.Top + 2
            .Left = cRange.Left + 2
            .Placement = xlMoveAndSize

    End With
line22:
        Set cShape = Nothing
    Next
    Application.ScreenUpdating = True
End Sub

The code works as shown in the following illustration.

But I want the image to be in all merged cells. As shown in the following picture

Please let me know if you see anything that will fix this! I'm sure it's something simple, but I've been stuck for a while on this one.

excel vba

Solution 1:^[1]

You can use the MergeArea property of the Range object to return the merged range. Your macro can amended as follows (untested) . . .

Sub Macro_1()
Dim cShape As Shape
Dim cRange As Range
Dim cColumn As Long
On Error Resume Next
Application.ScreenUpdating = False
Set xRange = ActiveSheet.Range("C5, G5, C8, G8")
For Each cell In xRange
    cName = cell
    ActiveSheet.Pictures.Insert(cName).Select
    Set cShape = Selection.ShapeRange.Item(1)
    If cShape Is Nothing Then GoTo line22
    cColumn = cell.Column
    Set cRange = cell.MergeArea
    With cShape
          .LockAspectRatio = msoFalse
            .Height = cRange.Height - 5
            .Width = cRange.Width - 5
            .Top = cRange.Top + 2
            .Left = cRange.Left + 2
            .Placement = xlMoveAndSize

    End With
line22:
        Set cShape = Nothing
    Next
    Application.ScreenUpdating = True
End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution	Source
Solution 1	Domenic

'Load image to fit in merged cell

Solution 1:[1]

Sources

Related Questions

Solution 1:^[1]