How to save inserted pictures in excel using VBA?

Question

I was trying to insert some pictures that are saved on my desktop to an excel file.

I found that some online codes worked well. But it seemed that those inserted pictures were not saved with the documents - the inserted pictures won't be displayed when I opened the file on another computer. I am wondering how I should tweak the codes so it can save the inserted pictures within the excel? If possible with VBA, how to adjust the inserted pictures to their 50% dimensions? I am completely new to VBA. Sorry for this basic question.

Sub add_pictures_R2()
Dim i%, ppath$
For i = 2 To 145   
    ' file name at column A
    ppath = "C:\Users\myname\output\" & CStr(Cells(i, 1).Value) & ".png"
    If Len(Dir(ppath)) Then
        With ActiveSheet.Pictures.Insert(ppath)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = 75
            .Height = 300
        End With
        .Left = ActiveSheet.Cells(i, 10).Left
        .Top = ActiveSheet.Cells(i, 10).Top
        .Placement = 1
        .PrintObject = True
    End With
    End If
    
Next
End Sub

See the comment under this previous answer -https://stackoverflow.com/a/12936911/478884 — Tim Williams, Jul 27 '22 at 15:33
@TimWilliams Thanks for sharing the link. Based on the comments from the link, including `With ActiveSheet.Pictures.Insert(Filename:=ppath, LinkToFile:=False, SaveWithDocument:=True)` should solve my issue. But it turns out that it will cause an error called "Run-time error 488. Named argument not found". — Chemist learns to code, Jul 27 '22 at 16:25

score 0 · Answer 1 · answered Jul 27 '22 at 15:38

0

You can do either, edit the path of the file to go along with your excel file or you could embed it. For embedding I would look at this. https://danny.fyi/embedding-and-accessing-a-file-in-excel-with-vba-and-ole-objects-4d4e7863cfff

Its a bit messy but you would achieve what you want to do with at least the file being in the document and not trying to transfer everything with it.

answered Jul 27 '22 at 15:38

JustARandomPerson

1
1
3

[link only answers](https://meta.stackexchange.com/questions/92505/should-i-flag-answers-which-contain-only-a-link-as-not-an-answer) are not accepted on StackOverflow. Please copy the relevant code snippets, just what is needed to answer the question. You can read that link for a full discussion on why. – HackSlash Jul 27 '22 at 15:55
Your answer could be improved with additional supporting information. Please [edit] to add further details, such as citations or documentation, so that others can confirm that your answer is correct. You can find more information on how to write good answers [in the help center](/help/how-to-answer). – Community Jul 28 '22 at 09:26

score 0 · Answer 2 · answered Jul 27 '22 at 18:45

0

Try this (using Shapes.AddPicture)

Sub add_pictures_R2()
    'Note - type identifiers such as `S`, `%` are very outdated...
    Dim i As Long, ppath As String, ws As Worksheet, c As Range
    
    Set ws = ActiveSheet  'use a specific/explicit sheet reference
    For i = 2 To 145
        ppath = "C:\Users\myname\output\" & CStr(ws.Cells(i, 1).Value) & ".png"
    
        Set c = ws.Cells(i, 10) 'insertion point
        'passing -1 to Width/Height preserves original size
        With ws.Shapes.AddPicture(Filename:=ppath, linktofile:=msoFalse, _
                                  savewithdocument:=msoTrue, _
                                  Left:=c.Left, Top:=c.Top, Width:=-1, Height:=-1)
            .LockAspectRatio = msoTrue
            .Placement = xlMove
            .Height = .Height / 2        'size to 50%
        End With
    Next i

End Sub

answered Jul 27 '22 at 18:45

Tim Williams

154,628
8
97
125

Thanks a lot for posting your code! Unfortunately, it didn't work. I got an error message " Ru-time error `1004`: Application-defined or object-defined error". – Chemist learns to code Jul 27 '22 at 18:55
On which line ? Maybe check your file paths – Tim Williams Jul 27 '22 at 19:55
I cannot tell. How can I find which line caused the error? – Chemist learns to code Jul 27 '22 at 20:03
When it errors, click "Debug" – Tim Williams Jul 27 '22 at 20:29

score 0 · Accepted Answer · answered Jul 28 '22 at 13:10

I got the answer from Jimmypop at mrexcel. It worked.

Sub add_pictures_R2()
        Const folderPath As String = "C:\Users\YANG\output\"
        Dim r As Long
        Application.ScreenUpdating = False
        With ActiveSheet
            For r = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
                If Dir(folderPath & .Cells(r, "A").Value & ".png") <> vbNullString Then
                    .Shapes.AddPicture Filename:=folderPath & .Cells(r, "A").Value & ".png", _
                                       LinkToFile:=False, SaveWithDocument:=True, _
                                       Left:=ActiveSheet.Cells(r, 10).Left, Top:=ActiveSheet.Cells(r, 10).Top, Width:=.Cells(r, "C").Width, Height:=.Cells(r, "C").Height
                
                Else
                    .Cells(r, "B").Value = "Not found"
                End If
                DoEvents
            Next
        End With
            Set myDocument = Worksheets(1)
    For Each s In myDocument.Shapes
        Select Case s.Type
        Case msoLinkedPicture, msoPicture
            s.ScaleHeight 0.5, msoTrue
            s.ScaleWidth 0.5, msoTrue
        Case Else
    '       Do Nothing
        End Select
    Next
        Application.ScreenUpdating = True
            MsgBox "Done"
    End Sub

How to save inserted pictures in excel using VBA?

3 Answers3