CODEWITHSUNDEEP
excelvba
BakerDan
BakerDan

Reputation: 21

Select, insert and center a photo in the merged cell

I'm a R&D baker and making a recipe template for my team, In the template there's the photo, but I need to easily allow them to click a button that will open a file selector for the photo, then center that photo in the merged cells. I'm not really good at doing this..

enter image description here

Sub InsertPhotoMacro()
    Dim photoNameAndPath As Variant
    Dim photo As Picture

    photoNameAndPath = Application.GetOpenFilename(Title:="Select Photo to Insert")
    
    If photoNameAndPath = False Then Exit Sub
    
    Set photo = ActiveSheet.Pictures.Insert(photoNameAndPath)
    
    With photo
        .Left = ActiveSheet.Range("E23").Left
        .Top = ActiveSheet.Range("E23").Top
        .Width = ActiveSheet.Range("F29").Width
        .Height = ActiveSheet.Range("F29").Height
        .Placement = 1
    End With
End Sub

Upvotes: 2

Views: 544

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149295

To Select, Insert and Fill the cell, try this. Just centering it is not enough. What if the image is bigger than the merged cell?

Option Explicit

Sub InsertPhotoMacro()
    Dim photoNameAndPath As Variant
    Dim photo As Picture
    Dim ws As Worksheet
    Dim MrdgCell As Range
    
    '~~> This is your worksheet
    Set ws = ActiveSheet
    '~~> And this is the merged cell
    Set MrdgCell = ws.Range("E23")
    
    photoNameAndPath = Application.GetOpenFilename(Title:="Select Photo to Insert")
    
    If photoNameAndPath = False Then Exit Sub
    
    Set photo = ActiveSheet.Pictures.Insert(photoNameAndPath)
    
    With photo
        '~~> Disable lock aspect ratio that we can freely transform
        .ShapeRange.LockAspectRatio = msoFalse
        
        .Left = MrdgCell.Left
        .Top = MrdgCell.Top
        
        '~~> This is the total merged area height and width
        .Height = MrdgCell.MergeArea.Height
        .Width = MrdgCell.MergeArea.Width
    End With
End Sub

BEFORE

enter image description here

AFTER (SCENARIO 1)

enter image description here

And if you do not want to Fill but just Center the image then try this

Option Explicit

Sub InsertPhotoMacro()
    Dim photoNameAndPath As Variant
    Dim photo As Picture
    Dim ws As Worksheet
    Dim MrdgCell As Range
    
    '~~> This is your worksheet
    Set ws = ActiveSheet
    '~~> And this is the merged cell
    Set MrdgCell = ws.Range("E23")
    
    photoNameAndPath = Application.GetOpenFilename(Title:="Select Photo to Insert")
    
    If photoNameAndPath = False Then Exit Sub
    
    Set photo = ActiveSheet.Pictures.Insert(photoNameAndPath)
    
    With photo
        .Left = MrdgCell.Left + (MrdgCell.MergeArea.Width - .Width) / 2
        .Top = MrdgCell.Top + (MrdgCell.MergeArea.Height - .Height) / 2
    End With
End Sub

AFTER (SCENARIO 2)

enter image description here

LOGIC

Whatever option you use, understand how to arrive at the correct co-ordinates/dimensions

enter image description here

No need to use the start and the end cell. You can refer to the complete merged cell using .MergeArea.Width and .MergeArea.Height

So if you want to center, the calculation for LEFT will be

MERGED CELL LEFT + (MERGED CELL WIDTH - IMAGE WIDTH) / 2

Similarly for TOP, it will be

MERGED CELL TOP + (MERGED CELL HEIGHT - IMAGE HEIGHT) / 2

Upvotes: 4

Related Questions