Macro to insert picture which lets me email the doc with the inserted pictures

[Realtreegirl75]

I'm working on a report and I need to have a macro/button that inserts and resizes a picture to a cell and then I need to be able to attach that excel report to an email and send it off.
I have the macro/button to insert each picture and they work perfectly but when I attach the excel document to an email, the picture doesn't show up on the recipients end. When I go though the steps of Insert>Picture>From This Device (pulling from the same location), the picture shows up on the other end every time.
How do I change my macro so that the actual picture is imbedded instead of a link to the file location on my computer? My insert picture macro is below:

Dim fNameAndPath As Variant
Dim img As Picture
fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
If fNameAndPath = False Then Exit Sub
Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
With img
On Error Resume Next
ActiveSheet.Pictures("A193").Delete
If .Width > .Height Then
.ShapeRange.LockAspectRatio = msoFalse
.Left = ActiveSheet.Range("A193").Left
.Top = ActiveSheet.Range("A193").Top
.Height = ActiveSheet.Range("A193:R203").Height
.Width = ActiveSheet.Range("A193:R203").Width
.Placement = 1
.Name = "A193"
.PrintObject = True
Else
If .Height > .Width Then
.ShapeRange.LockAspectRatio = msoTrue
.Left = ActiveSheet.Range("A193").Left
.Top = ActiveSheet.Range("A193").Top
.Width = ActiveSheet.Range("A193:R203").Width
.Height = ActiveSheet.Range("A193:R203").Height
.Placement = 1
.Name = "A193"
.PrintObject = True
End If
End If

 

[Domenic]

Try using the AddPicture method of the Shapes object instead. For example...

    Dim shp As Shape
    Set shp = ActiveSheet.Shapes.AddPicture( _
        Filename:=fNameAndPath, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, _
        Left:=Range("A193").Left, _
        Top:=Range("A193").Top, _
        Width:=Range("A193:R203").Width, _
        Height:=Range("A193:R203").Height)

Hope this helps!

 

[Realtreegirl75]

@Domenic that worked absolutely perfectly! Thank you so much!

 

[Domenic]

That's great, you're very welcome, I'm glad I could help.

Cheers!

 

[Realtreegirl75]

@Domenic I have one more question for you....using the bit of code you shared, how would I rename a picture? My current code renames the picture based on the cell its inserted into (in this case "A193"). This is because I also have a "Clear Pictures" button that deletes all pictures based on their name. I've been unable to figure out how to add a name change.

 

[Domenic]

To rename the inserted picture, try...

shp.Name = "A193"