How to save inserted pictures in excel using VBA?-CodePudding

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

CodePudding user response：

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.

CodePudding user response：

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