Macro for filling an Excel cell with the content of a graphics file, for instance rose.jpg and then to sort columns on those cells that contain the gr

HarrySiers

Board Regular
Joined
May 27, 2015
Messages
61
Hello Forumers,

Is it possible to fill an Excel cell with the content of a graphics file, for instance a graphics file rose.jpg by manually clicking on a number of cells in column A, and then to sort colums on those cells that contain the graphic?

Harry
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
You cannot sort pictures alone but if column B contains the name of the pictures, you can select columns A and B and sort by column B.
 
Upvote 0
Thanks a lot, yky, would you know if it is possible to have a graphic displayed in a cell by clicking on the cell? In order to flag rows in a nice way, with a graphic instead of by placing a letter such as Y for Yes or N for No in the first cell of the row?

Harry
 
Upvote 0
Yes. It is possible to double-click a cell and have a picture inserted to that cell or any cell in the sheet. Are you familiar with VBA? If you are, I have codes that you can modify to suit your need.
 
Upvote 0
Yes. It is possible to double-click a cell and have a picture inserted to that cell or any cell in the sheet. Are you familiar with VBA? If you are, I have codes that you can modify to suit your need.

Hello yky, I am a beginner, but have learned some basic things about VBA, so, yes, some code to have a picture inserted to a cell would be nice! Thank you in advance, Harry
 
Upvote 0
My code is more complex than what you actually need. I use this program to generate a catalog file. The program reads name of the picture files in a column and insert the corresponding pictures in another column.

For your purpose, you may want to put the code in the Worksheet_BeforeDoubleClick event and modify the program so it insert a picture to the cell you double-click.

I first insert the picture, figure out its size, then shrink it according to cell width. If you know the size of the picture to be inserted, you can ignore most of the code and concentrate on the AddPicture. That line is probably all you need.


Code:
Sub Insert_Picture()'take item number in Name_Column, insert corresponding picture in Picture_Column


Const Sheet_to_Insert_Picture = 1
Const Name_Column = 9 'column that holds the name of the picture file
Const Picture_Column = 1 'column that holds pictures
Dim p As Object
Dim cell_width As Double
Dim cell_height As Double
Dim factor As Double
Dim Top_Offset As Integer   'offset of picture top
Dim Last_Row As Integer 'last row in thisworkbook.sheets(sheet_to_insert_picture)
Dim rng As Range    'range of the cells to add pictures to
Dim cell As Range
Dim Path_Prefix As String
Dim Group_Code As String
Dim temp_width As Double
Dim temp_height As Double
Dim Starting_Row As Integer


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Path_Prefix = "D:\PICTURE DATABASE\"


Starting_Row = 444


Set rng = ActiveSheet.Range(ActiveSheet.Cells(Starting_Row, Name_Column), ActiveSheet.Cells(Starting_Row, Name_Column).End(xlDown))


For Each cell In rng


If Len(Dir(Path_Prefix  & "\" & cell.Value & ".jpg")) <> 0 Then
Set p = Workbooks(ActiveSheet.Parent.Name).Sheets(Sheet_to_Insert_Picture).Pictures.Insert(Path_Prefix & "\" & _
cell.Value & ".jpg")


p.Left = ActiveSheet.Cells(cell.Row, Picture_Column).Left
p.Top = ActiveSheet.Cells(cell.Row, Picture_Column).Top
cell_width = ActiveSheet.Cells(cell.Row, Picture_Column).Width
cell_height = ActiveSheet.Cells(cell.Row, Picture_Column).Height


factor = cell_width / p.Width
ActiveSheet.Cells(cell.Row, 1).RowHeight = p.Height * cell_width / p.Width


temp_width = p.Width * factor * 0.95
temp_height = p.Height * factor * 0.95


Workbooks(ActiveSheet.Parent.Name).Sheets(Sheet_to_Insert_Picture).Shapes(p.Name).Delete


Set p = Workbooks(ActiveSheet.Parent.Name).Sheets(ActiveSheet.Name).Shapes.AddPicture(Filename:=Path_Prefix  & "\" & _
cell.Value & ".jpg", LinkToFile:=False, SaveWithDocument:=True, Left:=ActiveSheet.Cells(cell.Row, Picture_Column).Left + _
(ActiveSheet.Cells(cell.Row, Picture_Column).Width - temp_width) / 2, _
Top:=ActiveSheet.Cells(cell.Row, Picture_Column).Top + (ActiveSheet.Cells(cell.Row, Picture_Column).Height - temp_height) / 2, Width:=temp_width, Height:=temp_height)


End If


Next


'ActiveWorkbook.Save 'savechanges:=True


Application.DisplayAlerts = False
Application.DisplayAlerts = True


End Sub
 
Upvote 0
My code is more complex than what you actually need. I use this program to generate a catalog file. The program reads name of the picture files in a column and insert the corresponding pictures in another column.

For your purpose, you may want to put the code in the Worksheet_BeforeDoubleClick event and modify the program so it insert a picture to the cell you double-click.

I first insert the picture, figure out its size, then shrink it according to cell width. If you know the size of the picture to be inserted, you can ignore most of the code and concentrate on the AddPicture. That line is probably all you need.


Code:
Sub Insert_Picture()'take item number in Name_Column, insert corresponding picture in Picture_Column


Const Sheet_to_Insert_Picture = 1
Const Name_Column = 9 'column that holds the name of the picture file
Const Picture_Column = 1 'column that holds pictures
Dim p As Object
Dim cell_width As Double
Dim cell_height As Double
Dim factor As Double
Dim Top_Offset As Integer   'offset of picture top
Dim Last_Row As Integer 'last row in thisworkbook.sheets(sheet_to_insert_picture)
Dim rng As Range    'range of the cells to add pictures to
Dim cell As Range
Dim Path_Prefix As String
Dim Group_Code As String
Dim temp_width As Double
Dim temp_height As Double
Dim Starting_Row As Integer


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Path_Prefix = "D:\PICTURE DATABASE\"


Starting_Row = 444


Set rng = ActiveSheet.Range(ActiveSheet.Cells(Starting_Row, Name_Column), ActiveSheet.Cells(Starting_Row, Name_Column).End(xlDown))


For Each cell In rng


If Len(Dir(Path_Prefix  & "\" & cell.Value & ".jpg")) <> 0 Then
Set p = Workbooks(ActiveSheet.Parent.Name).Sheets(Sheet_to_Insert_Picture).Pictures.Insert(Path_Prefix & "\" & _
cell.Value & ".jpg")


p.Left = ActiveSheet.Cells(cell.Row, Picture_Column).Left
p.Top = ActiveSheet.Cells(cell.Row, Picture_Column).Top
cell_width = ActiveSheet.Cells(cell.Row, Picture_Column).Width
cell_height = ActiveSheet.Cells(cell.Row, Picture_Column).Height


factor = cell_width / p.Width
ActiveSheet.Cells(cell.Row, 1).RowHeight = p.Height * cell_width / p.Width


temp_width = p.Width * factor * 0.95
temp_height = p.Height * factor * 0.95


Workbooks(ActiveSheet.Parent.Name).Sheets(Sheet_to_Insert_Picture).Shapes(p.Name).Delete


Set p = Workbooks(ActiveSheet.Parent.Name).Sheets(ActiveSheet.Name).Shapes.AddPicture(Filename:=Path_Prefix  & "\" & _
cell.Value & ".jpg", LinkToFile:=False, SaveWithDocument:=True, Left:=ActiveSheet.Cells(cell.Row, Picture_Column).Left + _
(ActiveSheet.Cells(cell.Row, Picture_Column).Width - temp_width) / 2, _
Top:=ActiveSheet.Cells(cell.Row, Picture_Column).Top + (ActiveSheet.Cells(cell.Row, Picture_Column).Height - temp_height) / 2, Width:=temp_width, Height:=temp_height)


End If


Next


'ActiveWorkbook.Save 'savechanges:=True


Application.DisplayAlerts = False
Application.DisplayAlerts = True


End Sub

Great, yky, thanks a lot. I will try it out and let you know! Looking forward to see a graphic appear in a cell.
 
Upvote 0
OK. Once I figured out you only need one line, this is what I came up with. You need to change the width and height to fit the size of you picture and path to your file.

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim p As Object


Set p = ThisWorkbook.Sheets(1).Shapes.AddPicture(Filename:="D:\PICTURE DATABASE\DSC02029.JPG", LinkToFile:=False, _
SaveWithDocument:=True, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=153, Height:=204)


End Sub
 
Upvote 0
OK. Once I figured out you only need one line, this is what I came up with. You need to change the width and height to fit the size of you picture and path to your file.

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim p As Object


Set p = ThisWorkbook.Sheets(1).Shapes.AddPicture(Filename:="D:\PICTURE DATABASE\DSC02029.JPG", LinkToFile:=False, _
SaveWithDocument:=True, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=153, Height:=204)


End Sub

Thank you, yky, for getting back with a one-line code. It is not working yet, but I am sure it will soon. I opened my illustration, which had extension jpeg instead of jpg, in Paint, chose resize, filled in 153 as horizontal (in pixels), after which the program automatically gave me 100 for vertical (in pixels), which values I accepted. (I noticed in the code above that Height (204) has a higher value than Width (153), something which I could not set in Paint), I saved the file, with the intention to choose jpg instead of jpeg for the extension, to adhere to the code above. Paint did not give me that choice. I saved the file and it turned out to be given the extension jpg by default.

Then I changed 204 in the code above to 100, left the Width value unchanged (153), changed the path "D:\PICTURE DATABASE\DSC02029.JPG" to the file name path (C:\Users\[user name]\Desktop\[Folder name][Illustration name.jpg], took care to observe case sensitivity in the path, file and extension names, and ran the macro by pressing F5 in VBA editor. No error message, but no illustration in the Excel-sheet either yet. I also tried to run the macro from within the work sheet via the button Macro in the ribbon, and tried to run it after changing jpg to jpeg in the code and running it on an illustration with the extension jpeg.

To be continued..., I will let you know.

Regards,
Harry
 
Last edited:
Upvote 0
You need to put the code in the worksheet event. In the VB editor, you double click on the sheet where you want the action to happen, on the pulldown menu, you select Worksheet. On the pulldown menu further to the right, you select BeforeDoubleClick. Then paste code there.

For further info, please read the following page:

Events In Excel VBA
 
Upvote 0

Forum statistics

Threads
1,213,496
Messages
6,113,993
Members
448,539
Latest member
alex78

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