Jasen79
New Member
- Joined
- Nov 25, 2020
- Messages
- 47
- Office Version
- 365
- Platform
- Windows
- 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?
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: