Help With ActiveSheet.Shapes.AddPicture

Jasen79

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
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?

VBA Code:
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
 
Last edited by a moderator:

Jasen79

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
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.
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

Jasen79

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
You would need cel.Worksheet.Shapes.addpicture rather than cel.Parent.addpiture
Do you mean like this?
I get a syntax error.
VBA Code:
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

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
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

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Try if this works for you.
VBA Code:
'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

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS

ADVERTISEMENT

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

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,951
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
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

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS

ADVERTISEMENT

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"
20201201_162752.jpg
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,951
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
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

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
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

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,951
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
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?
 

Watch MrExcel Video

Forum statistics

Threads
1,133,271
Messages
5,657,764
Members
418,411
Latest member
Excellency

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top