vba button to add image to sheet and save with workbook, not link.

[wagmanm]

I want to have a button to add a picture to a sheet. I thought I accomplished this with the code below, only to find out it only shows the pictures on my computer. Apparently this only links the file.

Can anyone help me so that this will save with the workbook and open on anyone's computer. There will only be a maximum of 50ish photos that are every loaded into this sheet at one time.

'Sub GetPic()
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
'Resize Picture to fit in the range....
.Left = ActiveSheet.Range("E4").Left
.Top = ActiveSheet.Range("E4").Top
.Width = ActiveSheet.Range("E4:K4").Width
'.Height = ActiveSheet.Range("E4:E24").Height
.Placement = 1
.PrintObject = True
End With
'End Sub

 

[GWteB]

How about

Sub GetPic()
    Dim fNameAndPath As Variant
    Dim img As Shape
    
    fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
    If fNameAndPath = False Then Exit Sub
    Set img = ActiveSheet.Shapes.AddPicture(Filename:=fNameAndPath, _
                                            LinkToFile:=False, SaveWithDocument:=True, _
                                            Left:=1, Top:=1, Width:=-1, Height:=-1)
    With img
        'Resize Picture to fit in the range....
        .Left = ActiveSheet.Range("E4").Left
        .Top = ActiveSheet.Range("E4").Top
        .Width = ActiveSheet.Range("E4:K4").Width
        '.Height = ActiveSheet.Range("E4:E24").Height
        .Placement = 1
        .DrawingObject.PrintObject = True
    End With
End Sub

 

[Logit]

wagmanm​

I used your macro example, selected two images from my computer, saved the workbook and then emailed it across the country. The recipient did not have
any problems viewing the images.

Are you saving your workbook after importing the images ?

 

[wagmanm]

How about

Sub GetPic()
    Dim fNameAndPath As Variant
    Dim img As Shape
   
    fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
    If fNameAndPath = False Then Exit Sub
    Set img = ActiveSheet.Shapes.AddPicture(Filename:=fNameAndPath, _
                                            LinkToFile:=False, SaveWithDocument:=True, _
                                            Left:=1, Top:=1, Width:=-1, Height:=-1)
    With img
        'Resize Picture to fit in the range....
        .Left = ActiveSheet.Range("E4").Left
        .Top = ActiveSheet.Range("E4").Top
        .Width = ActiveSheet.Range("E4:K4").Width
        '.Height = ActiveSheet.Range("E4:E24").Height
        .Placement = 1
        .DrawingObject.PrintObject = True
    End With
End Sub

This works perfectly! Thank you very much

 

[wagmanm]

wagmanm​

I used your macro example, selected two images from my computer, saved the workbook and then emailed it across the country. The recipient did not have
any problems viewing the images.

Are you saving your workbook after importing the images ?

Weird. It only added a link to it for me. it would not work on any other computer. but yes, saved and would open up on the the computer of the person who adds the picture. Regardless the code that GWteB posted works perfectly and saves the photo not the link. Thanks for looking into this.

 

[Logit]

Glad you have an answer.

 

[GWteB]

@wagmanm , you are welcome and thanks for letting us know.

@Logit, for now couldn't find any documentation about the pictures property/collection. The attached image shows the result of both wagmanm's code (at the left) and mine (at the right) on reopening of the workbook after the source image file was deleted.