Insert Image

[Ateeb Ali]

Dear Sir
I made a button and need vb code, when I click this button it will open browse function to insert image, when we select any image.

It should resize and fit in Cell: I34:N51 (I have merged the cell)

 

[chirayu]

This is a cross post. As per rules please ensure you always post links to other forums where you have posted the same thread

https://www.mrexcel.com/forum/excel...age-vb-code-excel.html?highlight=#post5194338

 

[Ateeb Ali]

This code I am using but the issue is width of picture, it is not fixing in A34:C34 and stretching it all the way to Column P

Please please help

Sub GetPic()
Dim fNameAndPath As Variant
Dim img As Picture
fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
If fNameAndPath = False Then Exit Sub
Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
With img
'Resize Picture to fit in the range....
.Left = ActiveSheet.Range("A34").Left
.Top = ActiveSheet.Range("A34").Top
.Width = ActiveSheet.Range("A34:C34").Width
.Height = ActiveSheet.Range("A34:A48").Height
.Placement = 1
.PrintObject = True
End With
End Sub

 

[Ajesh]

Try this. Change range A1 reference to top left cell of your merge area.

Sub GetPic()
Dim fNameAndPath As Variant
Dim pRng As Range
Dim pTop As Long, pLeft As Long, pHeight As Long, pWidth As Long

fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
If fNameAndPath = False Then Exit Sub

Set pRng = ActiveSheet.Range("A1")

With pRng.MergeArea
    pTop = .Top
    pLeft = .Left
    pHeight = .Height
    pWidth = .Width
End With

ActiveSheet.Pictures.Insert(fNameAndPath).Select

With Selection.ShapeRange
    .LockAspectRatio = msoFalse
    .Left = pLeft
    .Top = pTop
    .Width = pWidth
    .Height = pHeight
End With

With Selection
    .Placement = xlMoveAndSize
    .PrintObject = True
End With

End Sub

Thanks/Ajesh

 

[Ateeb Ali]

Thanks a lot, this worked out the best, great man