Replace image on sheet1 shape fill with image from sheet2 cell
Results 1 to 9 of 9

Thread: Replace image on sheet1 shape fill with image from sheet2 cell
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Jul 2019
    Posts
    42
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Replace image on sheet1 shape fill with image from sheet2 cell

    I have a rectangle with an image fill on sheet 1.

    On sheet 2 I have images that aren't a shape, they were just drag and dropped into Excel, but they are located within the cell borders

    I'm trying to figure out the code to take the image from a specific cell on sheet 2 and replace the shape image fill on sheet 1 with it.
    Is it possible to do this?
    Any help would be appreciated!

  2. #2
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    18,824
    Post Thanks / Like
    Mentioned
    35 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Replace image on sheet1 shape fill with image from sheet2 cell

    Place the following code in a regular module (Visual Basic Editor >> Insert >> Module). Note that it assumes that the workbook running the code contains the relevant sheets (Sheet1 and Sheet2).

    Code:
    Option Explicit
    
    Sub ReplaceRectangleImage()
    
    
        Dim rectangleShape As Shape
        Dim replacementImage As Shape
        
        Application.ScreenUpdating = False
        
        'set the rectangle (change the rectangle name accordingly)
        Set rectangleShape = ThisWorkbook.Worksheets("Sheet1").Shapes("Rectangle 1")
        
        'set the replacement image located in the specified cell (change the cell reference accordingly)
        Set replacementImage = GetReplacementImage(ThisWorkbook.Worksheets("Sheet2").Range("B2"))
        
        'if an image isn't found within the specified cell, exit the sub
        If replacementImage Is Nothing Then
            MsgBox "No image found!", vbExclamation
            Exit Sub
        End If
        
        'call sub to replace the image within the rectangle
        ReplaceImage rectangleShape, replacementImage
        
        Application.ScreenUpdating = True
        
    End Sub
    
    
    Function GetReplacementImage(ByVal Target As Range) As Shape
    
    
        Dim sourceWorksheet As Worksheet
        Dim currentShape As Shape
        
        Set sourceWorksheet = Target.Parent
        
        For Each currentShape In sourceWorksheet.Shapes
            If Not Intersect(currentShape.TopLeftCell, Target) Is Nothing Then
                If currentShape.Type = msoPicture Then
                    Set GetReplacementImage = currentShape
                    Exit Function
                Else
                    Set GetReplacementImage = Nothing
                    Exit Function
                End If
            End If
        Next currentShape
        
        Set GetReplacementImage = Nothing
        
    End Function
    
    
    Sub ReplaceImage(ByVal rectangleShape As Shape, ByVal replacementImage As Shape)
    
    
        Dim sourceWorksheet As Worksheet
        Dim temporaryChartObject As ChartObject
        Dim temporaryFile As String
        
        temporaryFile = Environ("temp") & "\temp.png"
        
        Set sourceWorksheet = replacementImage.Parent
        
        Set temporaryChartObject = sourceWorksheet.ChartObjects.Add(Left:=0, Top:=0, Width:=replacementImage.Width, Height:=replacementImage.Height)
        
        With temporaryChartObject
            .Activate
            With .Chart
                .ChartArea.Format.Line.Visible = msoFalse
                replacementImage.Copy
                .Paste
                .Export Filename:=temporaryFile, FilterName:="PNG"
            End With
            rectangleShape.Fill.UserPicture temporaryFile
            .Delete
        End With
        
        Kill temporaryFile
        
        rectangleShape.Parent.Activate
        
    End Sub
    Hope this helps!

  3. #3
    New Member
    Join Date
    Jul 2019
    Posts
    42
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Replace image on sheet1 shape fill with image from sheet2 cell

    Quote Originally Posted by Domenic View Post
    Place the following code in a regular module (Visual Basic Editor >> Insert >> Module). Note that it assumes that the workbook running the code contains the relevant sheets (Sheet1 and Sheet2).

    Code:
    Option Explicit
    
    Sub ReplaceRectangleImage()
    
    
        Dim rectangleShape As Shape
        Dim replacementImage As Shape
        
        Application.ScreenUpdating = False
        
        'set the rectangle (change the rectangle name accordingly)
        Set rectangleShape = ThisWorkbook.Worksheets("Sheet1").Shapes("Rectangle 1")
        
        'set the replacement image located in the specified cell (change the cell reference accordingly)
        Set replacementImage = GetReplacementImage(ThisWorkbook.Worksheets("Sheet2").Range("B2"))
        
        'if an image isn't found within the specified cell, exit the sub
        If replacementImage Is Nothing Then
            MsgBox "No image found!", vbExclamation
            Exit Sub
        End If
        
        'call sub to replace the image within the rectangle
        ReplaceImage rectangleShape, replacementImage
        
        Application.ScreenUpdating = True
        
    End Sub
    
    
    Function GetReplacementImage(ByVal Target As Range) As Shape
    
    
        Dim sourceWorksheet As Worksheet
        Dim currentShape As Shape
        
        Set sourceWorksheet = Target.Parent
        
        For Each currentShape In sourceWorksheet.Shapes
            If Not Intersect(currentShape.TopLeftCell, Target) Is Nothing Then
                If currentShape.Type = msoPicture Then
                    Set GetReplacementImage = currentShape
                    Exit Function
                Else
                    Set GetReplacementImage = Nothing
                    Exit Function
                End If
            End If
        Next currentShape
        
        Set GetReplacementImage = Nothing
        
    End Function
    
    
    Sub ReplaceImage(ByVal rectangleShape As Shape, ByVal replacementImage As Shape)
    
    
        Dim sourceWorksheet As Worksheet
        Dim temporaryChartObject As ChartObject
        Dim temporaryFile As String
        
        temporaryFile = Environ("temp") & "\temp.png"
        
        Set sourceWorksheet = replacementImage.Parent
        
        Set temporaryChartObject = sourceWorksheet.ChartObjects.Add(Left:=0, Top:=0, Width:=replacementImage.Width, Height:=replacementImage.Height)
        
        With temporaryChartObject
            .Activate
            With .Chart
                .ChartArea.Format.Line.Visible = msoFalse
                replacementImage.Copy
                .Paste
                .Export Filename:=temporaryFile, FilterName:="PNG"
            End With
            rectangleShape.Fill.UserPicture temporaryFile
            .Delete
        End With
        
        Kill temporaryFile
        
        rectangleShape.Parent.Activate
        
    End Sub
    Hope this helps!
    Hey, thanks so much for taking the time to reply.

    It doesn't seem to work for me, but that could just be me not implanting it correctly. I just want to check I've changed the right parts of your code so I'll refer to it by your comment line

    'set the rectangle (change the rectangle name accordingly)
    Set rectangleShape = ThisWorkbook.Worksheets("this is where I put the name of the sheet that contains the rectangle that contains the image fill that needs to change, right?").Shapes("this is the name of the rectangle shape?")

    'set the replacement image located in the specified cell (change the cell reference accordingly)
    Set replacementImage = GetReplacementImage(ThisWorkbook.Worksheets("this is the other sheet nam that contains the cell with the desired image?").Range("this is the cell number that contains the image? eg. C4?"))

    These are the only parts that I could tell needed parts replacing. Does the image located on sheet2 in cell eg. C4 need to have some sort of action performed to attach it to that cell properly? I did a drag-and-drop into the cell and ensured it was within the cell borders so it didn't cross over to cover 2 cells.

    Thanks again for your help!

    Oh I should point out, the running of the code didn't cause an error, it just didn't react

  4. #4
    New Member
    Join Date
    Jul 2019
    Posts
    42
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Replace image on sheet1 shape fill with image from sheet2 cell

    Quote Originally Posted by rbsam View Post
    Hey, thanks so much for taking the time to reply.

    It doesn't seem to work for me, but that could just be me not implanting it correctly. I just want to check I've changed the right parts of your code so I'll refer to it by your comment line

    'set the rectangle (change the rectangle name accordingly)
    Set rectangleShape = ThisWorkbook.Worksheets("this is where I put the name of the sheet that contains the rectangle that contains the image fill that needs to change, right?").Shapes("this is the name of the rectangle shape?")

    'set the replacement image located in the specified cell (change the cell reference accordingly)
    Set replacementImage = GetReplacementImage(ThisWorkbook.Worksheets("this is the other sheet nam that contains the cell with the desired image?").Range("this is the cell number that contains the image? eg. C4?"))

    These are the only parts that I could tell needed parts replacing. Does the image located on sheet2 in cell eg. C4 need to have some sort of action performed to attach it to that cell properly? I did a drag-and-drop into the cell and ensured it was within the cell borders so it didn't cross over to cover 2 cells.

    Thanks again for your help!

    Oh I should point out, the running of the code didn't cause an error, it just didn't react


    Ah so I realised that my button was set to only run my code and not yours. I wasn't sure how to make the button run multiple macros so I inserted the code:

    Sub RunAll()
    Call insert
    Call GetReplacementImage
    Call ReplaceImage
    Call ReplaceRectangleImage
    End Sub

    and then assigned the macro 'RunAll' to the button

    However when I click the button I get:

    Compile error: Argument not optional

    and then it highlights Sub RunAll()

    I'm not sure what happened because one time when I clicked it it actually did produce the image in question, but it was inside a chart fixed to the very top left of Sheet2 (should be sheet 1), but I haven't been able to reproduce that

    By the way, when I went to assign a Macro to the button, it listed in my code 'insert', your code 'ReplaceRectangleImage' but it didn't list 'ReplaceImage' or 'GetReplacementImage' (maybe it's because GetReplacementImage is a function, not a sub? but it didn't list 'ReplaceImage')

  5. #5
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    18,824
    Post Thanks / Like
    Mentioned
    35 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Replace image on sheet1 shape fill with image from sheet2 cell

    You only need to call ReplaceRectangleImage, which will in turn call the GetReplacementImage and ReplaceImage...

    Code:
    Sub RunAll()
        Call insert
        Call ReplaceRectangleImage
    End Sub

  6. #6
    New Member
    Join Date
    Jul 2019
    Posts
    42
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Replace image on sheet1 shape fill with image from sheet2 cell

    Ok, so now I'm getting

    Run-time error '-2147024894 (80070002)':
    Method of 'UserPicture' of object 'Fillformat' failed

    When I click Debug it highlight the line
    rectangleShape.Fill.UserPicture temporaryFile

    However, the weird thing, is it really messes with the viewing of the spreadsheet, it's like it's really zoomed out and zooming in is quite glitchy. But if you select any cell, then zoom in back to 100%, it seems to go back to normal. In addition to this, the image does get inserted correctly despite the error message, but it's not on sheet1, its on sheet2 which is where the image source is. It inserts it in the very top left corner of sheet2 as a picture ('Picture 1') and as I can't move it the only option is to delete it, which then reveals a blank white space behind it covering what was there before (like the textbook with the title of the project in the top left corner), and that's because this white space is considered a chart, I can then delete the chart and it reveals what is behind it (like the textbook title of the project)

    So it's capturing the source image correctly, and it is inserting it, but it is inserting it on the wrong sheet and it is fixed to the top left and won't move

    Any ideas? thanks again for your help!

  7. #7
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    18,824
    Post Thanks / Like
    Mentioned
    35 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Replace image on sheet1 shape fill with image from sheet2 cell

    It would suggest that the file specified by temporaryFile does not exist. Other than calling ReplaceRectangleImage from another procedure, did you change the code at all?

  8. #8
    New Member
    Join Date
    Jul 2019
    Posts
    42
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Replace image on sheet1 shape fill with image from sheet2 cell

    Quote Originally Posted by Domenic View Post
    It would suggest that the file specified by temporaryFile does not exist. Other than calling ReplaceRectangleImage from another procedure, did you change the code at all?
    Nope, no other changes.

    I've developed a work around which I think is probably good enough to keep.

    Rather than the user drag-and-dropping the image into the cell, I've included a button that pops open the file browser. The user selects the image, the code retrieves the file path from their file selection and inserts a rectangle shape with the image fill of that file path. Because it's a rectangle with a image fill, I think I'll be able to reference it later easier than just an image dragged inside a cell.

    What do you think of this solution? It seems to work for me, but can you imagine anything that could break?

  9. #9
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    18,824
    Post Thanks / Like
    Mentioned
    35 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Replace image on sheet1 shape fill with image from sheet2 cell

    I think your solution is much better. It would eliminate the need to store the images within the file itself, which would reduce the size of the file. And, it would eliminate the need to create a temporary chartobject in order to first export the image to a file and then fill the shape with the image, making it more efficient.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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