How to save VBA inserted pictures within the excel?

[Chemist Yang]

Hi,

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\YANG\output\" & CStr(Cells(i, 1).Value) & ".png"
    If Len(Dir(ppath)) Then
        With ActiveSheet.Pictures.Insert(ppath)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = 23
            .Height = 100
        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

 

[Jimmypop]

Hi There

Will the below work for you?

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

 

[Chemist Yang]

Thanks so much! The code worked!

 

[Jimmypop]

Thanks for the feedback and glad we could help...

 

[Jimmypop]

Thanks so much! The code worked!

Maybe just an explanation why your images disappeared opening the file on another pc...

The way your code worked is it did insert the picture but was not taking into account that it should remain there... It inserted it a link... So whenever you opened on another pc the file was looking for the filepath you specified as well as the file...

Obviously this file and filepath does not exist on the other pc...hence it did not show ..

 

[aguskwzwqyi]

hey, i found this code similiar to my work with delete some script, but how to insert picture in other sheet