Page 1 of 2 12 LastLast
Results 1 to 10 of 11

Thread: Insert Picture in a Cell UDF

  1. #1
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10

    Lightbulb Insert Picture in a Cell UDF

    Hi All,

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

    Enjoy !!

    Code:
    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.
    Attached Files Attached Files
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  2. #2
    Senior Member
    Join Date
    Apr 2011
    Posts
    190
    Rep Power
    13
    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
    Last edited by DocAElstein; 06-11-2023 at 03:29 PM.
    xl2007 - Windows 7
    xl hates the 255 number

  3. #3
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    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.

    Code:
    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
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  4. #4
    Junior Member
    Join Date
    Apr 2012
    Posts
    1
    Rep Power
    0

    What about referencing a cell with the image location in it?

    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?

  5. #5
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    Hi,

    You could try this function to extract the hyperlink address.

    Code:
    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))
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  6. #6
    Junior Member
    Join Date
    Nov 2012
    Posts
    2
    Rep Power
    0

    Function and Excel 2003

    Quote Originally Posted by Admin View Post
    Hi All,

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

    Enjoy !!

    Code:
    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

  7. #7
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    Hi

    Try this version.

    Code:
    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.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  8. #8
    Junior Member
    Join Date
    Nov 2012
    Posts
    2
    Rep Power
    0

    Thks. How keep aspect ratio of picture.

    Quote Originally Posted by Admin View Post
    Hi

    Try this version.

    Code:
    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

  9. #9
    Junior Member
    Join Date
    Nov 2012
    Posts
    1
    Rep Power
    0
    Quote Originally Posted by Admin View Post
    Hi All,

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

    Enjoy !!

    Code:
    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.

  10. #10
    Senior Member
    Join Date
    Apr 2011
    Posts
    190
    Rep Power
    13
    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
    xl2007 - Windows 7
    xl hates the 255 number

Similar Threads

  1. Question on UDF LookUpConcat
    By K2` in forum Excel Help
    Replies: 4
    Last Post: 05-07-2013, 10:25 PM
  2. Trouble implementing UDF's
    By ProspectiveCounselor in forum Excel Help
    Replies: 4
    Last Post: 05-06-2013, 08:07 PM
  3. Automatically Insert Row
    By marreco in forum Excel Help
    Replies: 7
    Last Post: 12-21-2012, 06:43 PM
  4. Replies: 4
    Last Post: 05-03-2012, 10:28 AM
  5. UDF to Create In-Cell Chart in Excel
    By Admin in forum Download Center
    Replies: 0
    Last Post: 08-13-2011, 09:53 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •