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
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?
That would be great, but corporate will not allow that. I think I found a slight work around by air gapping a windows pc and just transferring the photos to a portable drive. This way the work can be done on the apple and copies will be there, then we can do a quick edit on the pc to pull the pictures in thanks to everyone's help with the code. Maybe later excel for apple will fix that issue, till then this is fastest. Thanks again.
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

Jasen79

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Cell Formulas
RangeFormula
A2:A6A2='APL MASTER'!A2
B2:G6B2='APL MASTER'!D2
H2:H6H2=A2
I2:K6I2='APL MASTER'!J2
Named Ranges
NameRefers ToCells
'APL DISTRIBUTE'!_FilterDatabase='APL DISTRIBUTE'!$A$2:$G$2H2
'APL MASTER'!_FilterDatabase='APL MASTER'!$A$2:$R$171A2

Hi Rory & YKY,

I am working on something new but similar.
I now need pictures to be inserted in to columns I, J, & K if there is data.
I assume I need to set a range in the VBA code this time around vs specific cells.
Would the code be "If ActiveCell.Column <> 9 Then"?
Then would it be a loop of each column?
If you have time to help I would again be grateful.
 

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