VBA to choose pic, and insert into specified merged cell

DCGNM

New Member
Joined
Feb 25, 2019
Messages
18
Hi All

I need help with a code that i want to apply to my Button that does as such.

Choose a pic from desktop, and insert it into specified Cell(Merged). The pic should then be centered in the cell, and enlarged/shrank to fit, while maintaining it's aspect ratio.

Appreciate any help that you guys can render.
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
try:
Code:
Sub ChangeImage()
    Dim Pic     As Object
    Dim rng     As Range: Set rng = Range("[COLOR=#ff0000]A1[/COLOR]").MergeArea
   
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Select an image file"
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "All Pictures", "*.*"

        If .Show = -1 Then
            Set Pic = ActiveSheet.Pictures.Insert(.SelectedItems(1))
            With rng
                Pic.Top = .Top
                Pic.Height = .Height
                Pic.Left = .Left + 0.5 * (.Width - Pic.Width)
            End With
        End If
    End With
End Sub
 
Upvote 0
Hi Yongle

Thank you so much. It worked perfectly. Sorry to trouble you. But if i want to add other picture formats like PNG, GIF. how do i add to the code?
also, if i want the picture to paste in 2 different mergearea, instead of the one(might need to paste the same picture in another sheet with the same size merged cell), how do i add to the code?

Thanks once again.
 
Upvote 0
But if i want to add other picture formats like PNG, GIF. how do i add to the code?
Code:
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "All Pictures", "*.*"
 
Upvote 0
Hi Yongle

Thanks again. Sorry, there was another question in the earlier reply.
What if i want to paste the picture in 2 different merged cells? would i need to set another rng2 =? and how would i add it in the code for it to insert the picture into 2 areas, both across different sheets.
 
Upvote 0
if i want the picture to paste in 2 different mergearea, instead of the one(might need to paste the same picture in another sheet with the same size merged cell), how do i add to the code?
Code:
[I] [COLOR=#a9a9a9]........previous code..[/COLOR]
     [COLOR=#d3d3d3]End With[/COLOR][/I]
[I]'insert Pic in other sheet[/I]
     Set rng = Sheets("[COLOR=#006400]Sheet2[/COLOR]").Range("[COLOR=#006400]C2[/COLOR]").MergeArea
     With rng
        Pic.Copy
        .Parent.Paste
        Set Pic = .Parent.Shapes(.Parent.Shapes.Count)
        Pic.Top = .Top
        Pic.Left = .Left + 0.5 * (.Width - Pic.Width)
    End With
[I][COLOR=#808080]End Sub[/COLOR][/I]
 
Last edited:
Upvote 0
Thank you Yongle. That works perfect now. I don't know how you guys remember all these. Try as i do, i can never master the logic
 
Upvote 0
I don't know how you guys remember all these
- my memory is a very fat well-thumbed notebook :LOL:

thanks for the feedback
(y)
 
Last edited:
Upvote 0
Hi Yongle

Sorry to refresh this topic. But i am experiencing cases whereby the picture's width is wide, and height short, the code tries to automatically autofit the height to the merged cells height, thereby blowing up the picture in terms of width, overflowing horizontally out of the merged cells(not keeping the width within the merged cells).
 
Upvote 0
after
Code:
                Pic.Height = .Height
insert
Code:
                If Pic.Width > .Width Then Pic.Width = .Width
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top