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]

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.

 

[Jasen79]

2301 APL MASTER Test sheet.xlsx
	A	B	C	D	E	F	G	H	I	J	K
2	ISSUE #	FLOOR	ROOM	WALL / Floor / Ceiling / or GRID LINES	OVERHEAD / OCCUPIED SPACE / UNDERFLOOR	DESCRIPTION /LOCATION	TYPE TAG	ISSUE #	PHOTO	PHOTO 2	PHOTO 3
3	1	Basement	020-Hall	WEST WALL	OCCUPIED SPACE	remember to link some pics	ABANDONED Conductor	1	TK1.jpg	TK2.jpg	TK3.jpg
4	2	Basement	020-Hall	SOUTH WALL	OCCUPIED SPACE	0	ABANDONED Conductor	2	TK4.jpg	EUCOM.JPG	PAE.JPG
5	3	Basement	19	SOUTH WALL	OCCUPIED SPACE	0	ABANDONED Conductor	3	0	0	0
6	4	Basement	19	SOUTH WALL	OCCUPIED SPACE	0	Building Material Left in Wall	4	0	0	0
APL DISTRIBUTE

Cell Formulas
Range	Formula
A2:A6	A2	='APL MASTER'!A2
B2:G6	B2	='APL MASTER'!D2
H2:H6	H2	=A2
I2:K6	I2	='APL MASTER'!J2

Named Ranges
Name	Refers To	Cells
'APL DISTRIBUTE'!_FilterDatabase	='APL DISTRIBUTE'!$A$2:$G$2	H2
'APL MASTER'!_FilterDatabase	='APL MASTER'!$A$2:$R$171	A2

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.