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

[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