Forum Discussion
VBA help for a Macro (inserting picture from file)
Brady-
Please follow the below steps to accomplish your task:
1. Open the Visual Basic Editor (VBE) using Alt + F11
2. Insert > Module
3. Paste the below code in the new code module
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("D9").Left
.Top = ActiveSheet.Range("D9").Top
.Width = ActiveSheet.Range("D9:H9").Width
.Height = ActiveSheet.Range("D9:D28").Height
.Placement = 1
.PrintObject = True
End With
End Sub
4. Go back to the worksheet
5. Right Click on the button > Assign Macro
6. Select the GetPic Macro
After following these steps you should get the expected result.
Thank you very much, indeed!
I just modified your code to override Aspect Ratio:
Sub GetPic()
Dim fNameAndPath As Variant
Dim img As Object
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....
.ShapeRange.LockAspectRatio = msoFalse
.Left = ActiveSheet.Range("A5").Left
.Top = ActiveSheet.Range("A5").Top
.Width = ActiveSheet.Range("A5:G5").Width
.Height = ActiveSheet.Range("A5:A20").Height
.Placement = 1
.PrintObject = True
End With
End Sub