Insert Picture in a Cell UDF

[Admin]

Hi All,

Here is a UDF, which helps to insert a picture into a cell.

Enjoy !!


Function INSERTPICTURE(ByVal PictureFullName As String, Optional ByVal PicWidth As Single = 200, _
Optional ByVal PicHeight As Single = 150)

'// Author : Kris @ ExcelFox.com

Dim CellActive As Range
Dim picPicture As Object

Set CellActive = Application.Caller

For Each picPicture In CellActive.Parent.Pictures
If picPicture.TopLeftCell.Address = CellActive.Address Then
picPicture.Delete
Exit For
End If
Next

Set picPicture = CellActive.Parent.Pictures.Insert(PictureFullName)
With picPicture
.Left = CellActive.Left + 1
.Top = CellActive.Top + 1
.Width = PicWidth
.Height = PicHeight
End With

End Function

use like =INSERTPICTURE("C:\Pictures\MyPicture.jpg")

PFA sample workbook.

[Rasm]

Kris
This is cool - is there way to insert the picture onto a chart, either in the plot area or the chart area?

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Admin]

Hi Rasm,


This is cool

Thanks.


is there way to insert the picture onto a chart, either in the plot area or the chart area?

Here you go.


Sub InsertPictureOnChart(ByRef xl_Chart As Chart, ByVal AreaIs As Long, ByVal FullPictureName As String)

With xl_Chart
If AreaIs = 0 Then
.PlotArea.Format.Fill.UserPicture FullPictureName
Else
.ChartArea.Format.Fill.UserPicture FullPictureName
End If
End With

End Sub
Sub kTest()

InsertPictureOnChart Sheet1.ChartObjects(1).Chart, 0, "C:\MyPictures\Picture1.jpg"

End Sub

[AE5JO]

This is really cool. Is it possible to set it up so that you can use it like =INSERTPICTURE(A2) where cell A2 contains either a hyperlink to the image or the path (images are stored in .\PictureFiles)? I'm trying to get the picture to change along with other data that is displayed. I can get the hyperlink or path to change in A2 but can't get the image itself to display based on that value.

I see that =INSERTPICTURE() is looking for a "string" that gets entered as PictureFullName for the line Set picPicture = CellActive.Parent.Pictures.Insert(PictureFullName) . Is there a way for it to use the displayed contents of a cell as PictureFullName?

[Admin]

Hi,

You could try this function to extract the hyperlink address.


Function GETADDRESS(ByRef HypRange As Range) As String
On Error Resume Next
GETADDRESS = HypRange.Hyperlinks.Item(1).Address
End Function

and call the function like

=INSERTPICTURE(GETADDRESS(A2))

[zapamato]

Hi All,

Here is a UDF, which helps to insert a picture into a cell.

Enjoy !!


Function INSERTPICTURE(ByVal PictureFullName As String, Optional ByVal PicWidth As Single = 200, _
Optional ByVal PicHeight As Single = 150)

'// Author : Kris @ ExcelFox.com

Dim CellActive As Range
Dim picPicture As Object

Set CellActive = Application.Caller

For Each picPicture In CellActive.Parent.Pictures
If picPicture.TopLeftCell.Address = CellActive.Address Then
picPicture.Delete
Exit For
End If
Next

Set picPicture = CellActive.Parent.Pictures.Insert(PictureFullName)
With picPicture
.Left = CellActive.Left + 1
.Top = CellActive.Top + 1
.Width = PicWidth
.Height = PicHeight
End With

End Function

use like =INSERTPICTURE("C:\Pictures\MyPicture.jpg")

PFA sample workbook.

Hi Kris! Is possible use this function in Excel 1997-200 or Excel 2003? Thks and Regards
Antonio

[Admin]

Hi

Try this version.


Function INSERTPICTURE(ByVal PictureFullName As String, Optional ByVal PicWidth As Single = 200, _
Optional ByVal PicHeight As Single = 150) As Boolean

'// Author : Kris @ ExcelFox.com

Dim CA As Range
Dim picPicture

Set CA = Application.Caller

If Val(Application.Version) < 12 Then
For Each picPicture In ActiveSheet.Shapes
If picPicture.TopLeftCell.Address = CA.Address Then
If picPicture.Type = msoLinkedPicture Then
picPicture.Delete
Exit For
End If
End If
Next
Set picPicture = ActiveSheet.Shapes.AddPicture(PictureFullName, 1, 0, CA.Left, CA.Top, PicWidth, PicHeight)
GoTo Finish
End If

For Each picPicture In ActiveSheet.Pictures
If picPicture.TopLeftCell.Address = CA.Address Then
picPicture.Delete
Exit For
End If
Next

Set picPicture = ActiveSheet.Pictures.Insert(PictureFullName)

With picPicture
.Left = CA.Left + 1
.Top = CA.Top + 1
.Width = PicWidth
.Height = PicHeight
End With
INSERTPICTURE = True
Exit Function
Finish:
INSERTPICTURE = True
End Function

Note: It works in 2003, not sure on older versions.

[zapamato]

Hi

Try this version.


Function INSERTPICTURE(ByVal PictureFullName As String, Optional ByVal PicWidth As Single = 200, _
Optional ByVal PicHeight As Single = 150) As Boolean

'// Author : Kris @ ExcelFox.com

Dim CA As Range
Dim picPicture

Set CA = Application.Caller

If Val(Application.Version) < 12 Then
For Each picPicture In ActiveSheet.Shapes
If picPicture.TopLeftCell.Address = CA.Address Then
If picPicture.Type = msoLinkedPicture Then
picPicture.Delete
Exit For
End If
End If
Next
Set picPicture = ActiveSheet.Shapes.AddPicture(PictureFullName, 1, 0, CA.Left, CA.Top, PicWidth, PicHeight)
GoTo Finish
End If

For Each picPicture In ActiveSheet.Pictures
If picPicture.TopLeftCell.Address = CA.Address Then
picPicture.Delete
Exit For
End If
Next

Set picPicture = ActiveSheet.Pictures.Insert(PictureFullName)

With picPicture
.Left = CA.Left + 1
.Top = CA.Top + 1
.Width = PicWidth
.Height = PicHeight
End With
INSERTPICTURE = True
Exit Function
Finish:
INSERTPICTURE = True
End Function

Note: It works in 2003, not sure on older versions.

Thanks Kris for your kind support. It work fine on 2003. But I have another question, ist possible keep aspct ratio of original picture. I read several posts in web and can't find any fine answer. Thks a lot for your support, again.

Zapamato

[Jen]

Hi All,

Here is a UDF, which helps to insert a picture into a cell.

Enjoy !!


Function INSERTPICTURE(ByVal PictureFullName As String, Optional ByVal PicWidth As Single = 200, _
Optional ByVal PicHeight As Single = 150)

'// Author : Kris @ ExcelFox.com

Dim CellActive As Range
Dim picPicture As Object

Set CellActive = Application.Caller

For Each picPicture In CellActive.Parent.Pictures
If picPicture.TopLeftCell.Address = CellActive.Address Then
picPicture.Delete
Exit For
End If
Next

Set picPicture = CellActive.Parent.Pictures.Insert(PictureFullName)
With picPicture
.Left = CellActive.Left + 1
.Top = CellActive.Top + 1
.Width = PicWidth
.Height = PicHeight
End With

End Function

use like =INSERTPICTURE("C:\Pictures\MyPicture.jpg")

PFA sample workbook.

The codes seem insert a picture once only. I can't do second time by putting a new path.

[Rasm]

Kris

I have used your code -- it works great -- I am using the one where I place pictures on a chart. However I have a sheet that contain all my settings --- so I have copied my picture into that sheet -- I am now trying to copy that picture (I have identified it as a shape) ---- I can copy shapes from one sheet to another --- But I cannot figure out how to copy a shape fom a sheet to a chart --- any idea
Thanks
Rasm

[jazbah]

HI2 AND THANKS FOR SHARING NICE INFO