Help With ActiveSheet.Shapes.AddPicture

[Jasen79]

Good Day, I am hoping one of you Brilliant coders can help me.

I have been trying to get this VDA code to work for months.

I have created a template for my office. On this template data is entered on one worksheet of the workbook. On the other the date from the cells is combined or moved to a printable/email sheet. My issue is when I need to email the form, The pictures that are associated with date are saved in folder. I need those pictures to be saved in the excel workbook. The code I have not works for looking up the pictures but will not save inside the workbook. Mr. Excel explained why this is and created a work around. But I can not get his work around to work with in my code. Can you please help?

Sub InsertirPictures()
'
' Personal Note: Below file path needs to be changed to where the IR phots are located!!!
'
    Const fPath = "C:\Users\576186\Pictures\"
    Dim a As Variant, cel As Range, picPath As String
    'Coder Note:
    'The Arry is feed by changing data.
    'The sheet graps date from another cell on anther worksheet.
    'The whole workbook is used a a templete.
    'So the date is changing but the soures of the photos is not.
    'But the ptces in that loctaion change/are added.
    For Each a In Array("A38", "F38", "A54", "F54")
        Set cel = Range(a)
        picPath = fPath & cel.Value
        'I need to be able to save and email the form out with the pictures in them.
        If Not Dir(picPath, vbDirectory) = vbNullString Then
            'Want This ActiveSheet.Shapes.AddPicture
            With cel.Parent.Pictures.Insert(picPath)
             LinkToFile = msoFalse
                SaveWithDocument = msoTrue
                With .ShapeRange
                    .LockAspectRatio = msoFalse
                    .Width = 209
                    .Height = 209
                End With
                .Left = cel.Offset(, 0).Left
                .Top = cel.Offset(, 0).Top
            End With
        End If
    Next a
End Sub

 

[yky]

Try if this works for you.

'Want This ActiveSheet.Shapes.AddPicture
If Not Dir(picPath, vbDirectory) = vbNullString Then

cel.parent.addpiture filename:=picpath, LinkToFile:= msoFalse, SaveWithDocument:= msoTrue, _
Top:= cel.Offset(, 0).Top, Left:= cel.Offset(, 0).Left, Width:=209, Height:=209

End If

 

[Jasen79]

Try if this works for you.

'Want This ActiveSheet.Shapes.AddPicture
If Not Dir(picPath, vbDirectory) = vbNullString Then

cel.parent.addpiture filename:=picpath, LinkToFile:= msoFalse, SaveWithDocument:= msoTrue, _
Top:= cel.Offset(, 0).Top, Left:= cel.Offset(, 0).Left, Width:=209, Height:=209

End If

First, Thanks for replying so quickly! That really nice of you.
I don't think I filled it in correctly. Should it look like this?

Sub InsertirPictures()
'
'
'
    Const fPath = "C:\Users\576186\Pictures\"
    Dim a As Variant, cel As Range, picPath As String
    
    For Each a In Array("A38", "F38", "A54", "F54")
        Set cel = Range(a)
        picPath = fPath & cel.Value
        'I need to be able to save and email the form out with the pictures in them.
        If Not Dir(picPath, vbDirectory) = vbNullString Then
            cel.Parent.addpiture Filename:=picPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
                Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=209, Height:=209
        End If
    Next a
End Sub

 

[yky]

Looks right. Does it work?

 

[Jasen79]

Looks right. Does it work?

Besides the small spelling error (addpiture/addpicture), sadly it did not work. ?
I have attached a link to the excel doc if you would like to take a closer look and see if you can get it to work from your end.
I really grateful for your help.

 

[Jasen79]

My Excel Picture doc
Here is the link. Was meant to be in the above message.

 

[RoryA]

You would need cel.Worksheet.Shapes.addpicture rather than cel.Parent.addpiture

 

[Jasen79]

You would need cel.Worksheet.Shapes.addpicture rather than cel.Parent.addpiture

Yes, I saw that and tried. I am using my work PC and they would not let the extension be added.

 

[RoryA]

I have no idea what that means, I'm afraid. What extension?

 

[yky]

My Excel Picture doc
Here is the link. Was meant to be in the above message.

It asked me to sign in. So, I can't download it.