VBA help for a Macro (inserting picture from file)

Copper Contributor



I am new to VBA and macros and I was hoping that someone could help me writing the VBA to insert a photo from your personal files. I created the button, but I just need to write the VBA to pull up the users files so they can select the photo. From there I want the photo to be placed in the cell (you'll see on the sheet which cell I am referring to). The cells are already merged together. I want the photo to fit in the cell that is already merged. 


For some reason this forum won't let me upload a macro, so I am going to insert the excel file. You'll see where I want the photo's on the "FLYER V1" tab. 


Thanks! Let me know if you have any questions 

24 Replies
Dear Sirs I have been trying without success to create a VBA or macro to automatically take a folder address of pictures and then match it ascending down from the pic name i.e hf-001.jpg by using the cell ref within the other cell say i.e hf-001 descending down to last populated cell is this possible as all I have managed to do is get 1 picture to populate 1 cell sorry if a big ask as a beginner in all this but trying my best to do as much on my own for a small charity.

I want a code of "Insert multiple Images on Multiple worksheets automatically" give path and run.
I don't want to choose path.

Please share

@Matt Mickle 


I like the code below.  I tried it and changed it so that it aligns uniformly across.


My goal is to add multiple images, at one time please advise how that can be done.



@Matt Mickle 

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


@dklein_14 ¿Cómo me vas a decir que te funcionó? Eso ¡no funciona!. Debe ser por la mala traducción al español.

¿Pueden bajar la macro sin traducirla? ¿Es posible?