Hi There! Trying to rock the dashboard with meaningful pictures. Or just trying to insert picture into cell Excel VBA. Well, you can’t insert pictures into excel cells but you can resize it to fit into excel cell. Doing it manually will take a lot of time and it's annoying. So what is the solution? You guessed it right, a VBA Macro. We will code now.
Below is the excel vba code to insert picture from a folder into a cell or a given range. Press Alt+F11, insert a module and copy this code.
Don’t worry, I have explained it below so that you can modify it according to your needs.
| Sub TestInsertPictureInRange()InsertPictureInRange "C:\FolderName\PictureFileName.gif", _Range("B5:D10")
End Sub ' inserts a picture and resizes it to fit the TargetCells range Dim p As Object, t As Double, l As Double, w As Double, h As Double If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub If Dir(PictureFileName) = "" Then Exit Sub ' import picture Set p = ActiveSheet.Pictures.Insert(PictureFileName) ' determine positions With TargetCells t = .Top l = .Left w = .Offset(0, .Columns.Count).Left - .Left h = .Offset(.Rows.Count, 0).Top - .Top End With ' position picture With p .Top = t .Left = l .Width = w .Height = h End With Set p = Nothing End Sub |
Part 1:
| Sub TestInsertPictureInRange()InsertPictureInRange "C:\FolderName\PictureFileName.gif", _Range("B5:D10")
End Sub |
The above subroutine just calls our main subroutine InsertPictureInRange that takes only two arguments. First the address of image file with its name and second Range where you want to insert the picture in Excel.
Part 2:
| Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)' inserts a picture and resizes it to fit the TargetCells rangeDim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub If Dir(PictureFileName) = "" Then Exit Sub ' import picture Set p = ActiveSheet.Pictures.Insert(PictureFileName) ' determine positions With TargetCells t = .Top l = .Left w = .Offset(0, .Columns.Count).Left - .Left h = .Offset(.Rows.Count, 0).Top - .Top End With ' position picture With p .Top = t .Left = l .Width = w .Height = h End With Set p = Nothing End Sub |
This is the main subroutine that inserts and resizes the picture to fit the given range. Let’s dig into it.
Dim p As Object, t As Double, l As Double, w As Double, h As Double
This line is just a variable declaration that we will need. Note p As the object variable. This variable will hold our picture.
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
It checks whether the Activesheet is a worksheet or not. If it does not, it will exit the code immediately and nothing will happen.
If Dir(PictureFileName) = "" Then Exit Sub
Check that you have provided an address for the image to insert a photo into the excel cell. If you have not provided it, it will exit immediately and nothing will happen.
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
Now, this is the most important line. In this line, we are using the Insert function of Activesheet. Pictures object and put it into the object p that we declared earlier. Now using p we can easily adjust the image’s width and length.
With TargetCells t = .Top l = .Left w = .Offset(0, .Columns.Count).Left - .Left h = .Offset(.Rows.Count, 0).Top - .Top End With
This segment just gets Length, Width, Top and Left from the given range.
With p .Top = t .Left = l .Width = w Height = h End With
This part adjusts the image to the given range. And it's done. Lastly, we set it free by setting it to nothing.
Set p = Nothing
This line free’s memory.
This code will work in Excel 2016, Excel 2013, Excel 2010 and Excel 2007.
Here I wanted to insert the image in range A1:C10. To do this, I modified my code below
| Sub TestInsertPictureInRange()InsertPictureInRange "C:\Users\Manish Singh\Downloads\biker.jpg", _Range("A1:C10")
End Sub |
And this is what I got. Exactly what I wanted.
So, yeah. Use this code to insert a picture into the excel cell or range. Play around the code. Try to insert different formats, strange ranges and see what happens. If you have any questions or are facing any challenge, use the below comments section to ask me.
Download file
The applications/code on this site are distributed as is and without warranties or liability. In no event shall the owner of the copyrights, or the authors of the applications/code be liable for any loss of profit, any problems or any damage resulting from the use or evaluation of the applications/code.
Great help. Thank you. it is perfectly working as i expected
Is there a way to do this but by replacing an existing image (shapes)? I need one that will allow the user to click the image and upload the image they need. I've been trying different methods I've seen around the web and on forums but not able to. If this is too different and I need to start a new forum then I can but thought this might be close enough that not much code would need to change. Currently I'm having the user right click, then select 'Change Picture', then upload theirs but I would like this to open the folder path they are needing.
Many thanks,
Andrew
thanks for your help.
Is there a way to set the active cell as the range? I am new to VBA.
Hi Paul,
You can use below code for setting the active cell as the range.
Dim rng As Range
Set rng = ActiveCell
Thought I would give you all another option. this one uses a combobox to get the image. combobox is populated with names, then the image name must be identical to the combobox name. for instance I would select Dog4 the image name for that selection is Dog4.
the first part just populates my textboxes the goes into calling the image.
Private Sub ComboBox4_Change()
'Declare Variables
Dim IDRow As Range
With Me
If .ComboBox4.ListIndex = -1 Then Exit Sub 'If Blank Value then....Exit Sub
'Find Number (ID) In Column 2 of Data Worksheet
Set IDRow = Sheets("Data").Columns(2).Find(Me.ComboBox4.List(Me.ComboBox4.ListIndex, 1))
'Set the textbox values
.Number1.Value = IDRow.Value
.TextBox3 = IDRow.Offset(, 1) 'Offset 1 Column Over i.e.
Data Name...
.id2.Value = IDRow.Offset(, 2) 'Offset 2 Column Over i.e. Data...
.id3.Value = IDRow.Offset(, 3) 'Offset 3 Column Over i.e. Method...
.Notes2.Value = IDRow.Offset(, 4) 'etc...
.Info1.Value = IDRow.Offset(, 5)
.Info2.Value = IDRow.Offset(, 6)
.Date.Value = IDRow.Offset(, 7)
'dim the variables
Dim i As Integer
Dim fPath As String
Dim Pic2 As String
'set the file path
fPath = ThisWorkbook.Path & "\" & "Images"
i = Me.ComboBox4.ListIndex
On Error Resume Next
'display the picture
Me.Pic2.Picture = LoadPicture(fPath & "\" & Me.ComboBox4.Column(0, i) & ".jpg")
'If recipe picture is not available
If Err = 53 Then
Me.Pic2.Picture = LoadPicture(fPath & "\" & "NoPicture.jpg")
End If
'reset error handler
On Error GoTo 0
End With
End Sub
hope some can get use out of this it has served me well.
note this is used in a userform. you will need to modify for worksheet I guess. if anyone converts for a worksheet please post back up as I am experimenting with OOo and LO
Hi Kumar,
You can use the below code to copy and paste the picture in all the sheets in the workbook except the active sheet.
You can use “If” statement to exempt any sheet from adding image banner.
Sub Pasting_Picture()
Dim sht As Worksheet
ActiveSheet.Pictures(1).Copy
For Each sht In Worksheets
If sht.Name ActiveSheet.Name Then
sht.Paste
End If
Next
End Sub
Is there any way we can use VBA to add image banners to the top in all except few different sheets in a workbook ?
Thanks,
Kumar
Hi Kumar,
You can use the below code to copy and paste the picture in all the sheets in the workbook except the active sheet.
You can use “If” statement to exempt any sheet from adding image banner.
Sub Pasting_Picture()
Dim sht As Worksheet
ActiveSheet.Pictures(1).Copy
For Each sht In Worksheets
If sht.Name ActiveSheet.Name Then
sht.Paste
End If
Next
End Sub
or you use directly image-xls . with this Excel addin you're able to insert unlimited number of Pictures into Excel cell, or as a comment. it also resizes your Pictures. and it's possible to order and filter your Excel sheet, including the Pictures !
Heloo,
I just wanted to know how can i retrive a image from desktop without selecting a range
for example:
i have created a macro and added a button in ribbon, so what i wanted is that when i click on that macro it should give a pop-up asking a name, after inserting name it should pop-up image.
can anyone please help.
Thanks,
karteek
Hi,
I cannot import the picture into a cell of excel with the following script by using a command button. The selected picture can be inserted and fitted to the cell by clicking this command button but it cannot be by read by different computers because the source of that picture cannot be found in the other computers.
Please help to modify this script so the inserted picture can be loaded into this excel file and it can be read by the other computers. Many thanks!!!
*****************************************************************************
Private Sub CommandButton37_Click()
Dim sPicture As String, pic As Picture
sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")
If sPicture = "False" Then Exit Sub
Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Height = Range("D25").Height
.Width = Range("D25").Width
.Top = Range("D25").Top
.Left = Range("D25").Left
.Placement = xlMoveAndSize
End With
Set pic = Nothing
End Sub
Hi,
I am unable to get the picture on my spread sheet. though my picture has the name but this code is picking as picturefilename as blank and it is not importing the picture. please help me to fix this.
Thanks in advance!
Here's a fix for it not centering correctly and making sure it doesn't extend past the range box
----------------------------------------------------------------------------------
Sub InsertPictureInRange(PictureFileName As String, WorksheetName As String, TargetCells As Range, centerH As Boolean, centerV As Boolean)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = Worksheets(WorksheetName).Pictures.Insert(PictureFileName)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.count).Left - .Left
h = .Offset(.Rows.count, 0).Top - .Top
End With
' position picture and resize
With p
.Top = t
.Left = l
.Width = w
If .Height > h Then
.Height = h
End If
End With
'Center Horizontally
Dim addLeft, addTop As Long
If (w > p.Width) And centerH Then
addLeft = (w - p.Width) / 2
p.Left = p.Left + addLeft
End If
'Center Vertically
If (h > p.Height) And centerV Then
addTop = (h - p.Height) / 2
p.Top = p.Top + addTop
End If
Set p = Nothing
End Sub
-----------------------------------------------------------------
I was able to create a resizing VBA of a picture from the clipboard but I am not sure what to add so I can add multiple pictures in the same active cell. It only althoughs me to paste once.
Secondly, if want to paste more in the active cell but I do not want them overlapping. I want them to automatically shift to the right or over and down like wrapped text would. How do I do this?
You MY GOD!!!!
Hi,
Thank you for this post, very useful!
Thank you so much for the great help!!
Hey
Thanks for the post.
But I have another Problem. I have to load over 1000 Pictures into different Excel flies but with the same Format. I want to know if there is a macro that allows me to load the Pictures only by naming them in a Worksheet.
I dont know if you undersrand me but like:
flield D4 has File Name 123456.jpg then range F4 to L24 should load Picture with the Name 123456.jpg.
Is that even possible?
Neo-Jan
Hi
Can someone help me with a makro which works in excel 2007?
I need to insert several pictures from a folder directly into 2 columns (A & B). Is it possible when saving the excel file with pictures to save automatically under the same name as the original folder has?
Any helpful tip is highly appreciated!
Regards,
Attila (only basic knowledge in excel)
Hi,
Please post your query @ www.excelforum.com, you will get appropriate reply immediately.
Thanks
I have tried both the method outlined here as well as another method found on the web (inserting a rectangle shape and filling it with a user image).
All methods seem to have some sort of compression going on.
I am trying to automate an e-signature for medical forms going out signed off on by the Dr.
Any tips?
Nothing seems to replicate how crisp the signature looks if I do it non-programmatically (insert->image->choose file)
Matthew, I had a similar task to complete, I did it by using a loop and array.
Sub TestInsertPictures()
' Used to import picture files from a pre-sorted file. (Each picture must have a unique name, duplicates removed).
Dim PictureName(1 to 500) As String 'Starting at row 1 and ending at row 500
Dim FullPathName As String
Dim Location(1 to 500) As String
Dim r As Integer 'loop count'
For r = 1 To 500
PictureName(r) = Cells(r,2) 'Column B
FullPathName = "C:\Folder\" & PictureName(r) & ".jpg"
Location(r) = Cells(r,2).Address
InsertPicture FullPathName, Range(Location(r)), False, False
Next r
End Sub
Hello,
I came across this post and think it could help me so I'm hoping you can help with just a little modification to the script.
Is it easy to do the following? Insert product images in to Cell A1 based on the SKU that is inputted in to B2. These images are stored in F:\Images\ I will have about 500 SKU's that all need images and will be named the same as the SKU I enter in to Column B.
Hope somebody can help me.
Matt
Matthew, I had a similar task to complete, I did it by using a loop and array.
Sub TestInsertPictures()
‘ Used to import picture files from a pre-sorted file. (Each picture must have a unique name, duplicates removed).
Dim PictureName(1 to 500) As String ‘Starting at row 1 and ending at row 500
Dim FullPathName As String
Dim Location(1 to 500) As String
Dim r As Integer ‘loop count’
For r = 1 To 500
PictureName(r) = Cells(r,2) ‘Column B
FullPathName = “C:\Folder\” & PictureName(r) & “.jpg”
Location(r) = Cells(r,2).Address
InsertPicture FullPathName, Range(Location(r)), False, False
Next r
End Sub
I agree. It would be complete to enable the macro to run on a selected range. The changes could include replacing the "-" sign between the contents of the cells with a space. (This is can be done by almost anyone).
"This just saved me a ton of time, thank you so much for posting!! If you ever edit this, it might be nice to enable the macro to either run on a certain range or an entire worksheet.
Thanks again, David"