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

 

[Jasen79]

Same File now on Google
Man all this security from my company is driving me nuts!
Hopefully this works. Put it on my google share drive.
Thank you again and for your patience.

 

[Jasen79]

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

Do you mean like this?
I get a syntax error.

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 Array is feed by changing data.
    'The sheet grabs date from another cell on anther worksheet.
    'The whole workbook is used a a template.
    'So the date is changing but the sources of the photos is not.
    'But the pictures in that location change/are added.
    For Each a In Array("A38", "F38", "A54", "F54")
        Set cel = Range(a)
        picPath = fPath & cel.Value
       'Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=209, Height:=209
        If Not Dir(picPath, vbDirectory) = vbNullString Then
            'Want This ActiveSheet.Shapes.AddPicture
             With cel.Worksheet.Shapes.AddPicture Filename:=picPath[/COLOR]
             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

 

[Jasen79]

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

I am sorry, I miss read.
Thank you so much. It worked!
Thank you Thnak you.

 

[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

Thank you so much for your help!
With the help of Rory and you, it now works!
I really appreciate it.
If you want I would be happy to send both of you some German Chocolate!
Really made my day!

 

[Jasen79]

Just wondering if you might know.

So, the code you both helped with works great.... on my company windows laptop. It works great on any windows system as it should.
But of course, my company has us using an Air gapped Apple Mac where we store all of our workable data.
So, the file and pictures are all stored on the Apple and we save the data using Excel/MS office.
When I put the new template on the Apple the Excel VBA would not work. ???????
Any guidance you might be able to provide?

 

[RoryA]

What exactly does "would not work" mean? I assume you changed the file path since that will not be a valid path on a Mac.

 

[Jasen79]

What exactly does "would not work" mean? I assume you changed the file path since that will not be a valid path on a Mac.

Yes, I changed the path. It says it does not "Identifier under courser not recognized"

 

[RoryA]

As I recall AddPicture is extremely buggy on a Mac. If you manually insert a particular picture, then delete it, code to put it back will work, even though that same code failed beforehand!

 

[Jasen79]

As I recall AddPicture is extremely buggy on a Mac. If you manually insert a particular picture, then delete it, code to put it back will work, even though that same code failed beforehand!

I am attempting to automate the process. We take all the photos from incidents our personnel report on. Sometime this is a few pictures or a few dozen. All the pictures are dumped in to a single folder. Normally if the report gets traction (Meaning someone higher wants to take action) then we send the pictures and some other details along. We/I thought it would be much easier if the photos could be sent with the report since the photos are referenced in the report already. It ends up being a big time saver for us later.

So if I understand correctly I would have to insert the pictures then delete and then run the code to place them back? If so that does not cut down on time, unfortunately. But thank you for your time and help. It is kind of you to help.

 

[RoryA]

Personally I'd suggest you try and avoid Mac Excel if you can. Can you run Windows on the Mac (either bootcamp or a VM solution like Parallels) so that you can use Windows Excel?