Forum Discussion

michalduszak's avatar
michalduszak
Copper Contributor
Jun 08, 2022
Solved

Linked pictures to embedded

Hello,

 

I have a macro to generate a spreadsheet with many worksheets with images. Unfortunately they have linked images. I need to send this file, but person who received it cannot display images. Cut and pasting every image in spreadsheet is not an option. Is there any solution to convert every image in document from picture to shape or another solution to this automatically for the entire spreadsheet? Maybe some simple macro, I found loops for every picture in worksheet but no idea how to turn them into embedded pictures. Editing orginal macro, which generates spreadsheets is also not an option, it's really complicated.

  • michalduszak 

    Try this:

    
    Sub ConvertLinkedShapes()
        Dim w As Worksheet
        Dim s As Shape
        Dim t As Single
        Dim l As Single
        Application.ScreenUpdating = False
        For Each w In Worksheets
            For Each s In w.Shapes
                If s.Type = msoLinkedPicture Then
                    t = s.Top
                    l = s.Left
                    s.Cut
                    w.Pictures.Paste
                    With w.Pictures(w.Pictures.Count)
                        .Top = t
                        .Left = l
                    End With
                End If
            Next s
        Next w
        Application.ScreenUpdating = True
    End Sub

2 Replies

  • michalduszak 

    Try this:

    
    Sub ConvertLinkedShapes()
        Dim w As Worksheet
        Dim s As Shape
        Dim t As Single
        Dim l As Single
        Application.ScreenUpdating = False
        For Each w In Worksheets
            For Each s In w.Shapes
                If s.Type = msoLinkedPicture Then
                    t = s.Top
                    l = s.Left
                    s.Cut
                    w.Pictures.Paste
                    With w.Pictures(w.Pictures.Count)
                        .Top = t
                        .Left = l
                    End With
                End If
            Next s
        Next w
        Application.ScreenUpdating = True
    End Sub

Resources