Inserting pictures into Excel and saving them within the excel document

[ryu1200]

Firstly I'd like to apologise as I am a complete N00b when it comes to Excel and VBA. What I have picked up so far has been done with much help of Google, however I am now stuck and in need of some expert help.

I've got some code setup to insert an image into a specific location within an excel worksheet, but it would seem to be only linking to the picture file, so when I email the excel document to someone else, the pictures fail to load.

I understand I need to tell excel not to link to, but to save the image, but I am unsure on how to do this. So far my code looks like:

Sub Photo1()
Application.ScreenUpdating = False

 ActiveSheet.UnProtect Password:="Password"
 Dim profile As String
    On Error GoTo 0
    Dim fd As FileDialog
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif;*.png"
        .ButtonName = "Select"
        .AllowMultiSelect = False
        .Title = "Choose Photo"
        .InitialView = msoFileDialogViewDetails
        .Show
    End With
    ActiveSheet.Range("A1").Select
    
    With ActiveSheet.Pictures.Insert(fd.SelectedItems(1), LinkToFile:=False, SaveWithDocument:=True)
        
        .Left = ActiveSheet.Range("photograph1").Left
        .Top = ActiveSheet.Range("photograph1").Top
        .Placement = 1
        .PrintObject = True
        
        profile = .Name
    End With
    ActiveSheet.Pictures(profile).Select
    With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .Width = 158
        .Height = 142
    End With
    ActiveSheet.Protect Password:="Password"
End Sub

From looking at google I need to add:

LinkToFile:= False, SaveWithDocument:= True

But I've no clue where in the above code it needs to sit. I keep trying but keep getting errors when I run the code.

Any help really appreciated.

 

[Domenic]

Instead of using the Insert method of the Pictures object, use the AddPicture method of the Shapes object...

ActiveSheet.Shapes.AddPicture( . . .

Hope this helps!

 

[ryu1200]

Instead of using the Insert method of the Pictures object, use the AddPicture method of the Shapes object...

ActiveSheet.Shapes.AddPicture( . . .

Hope this helps!

Many thanks Domenic, however I am still having issues. My code now looks like:

Sub Photo1()
Application.ScreenUpdating = False

 ActiveSheet.UnProtect Password:="Password"
 Dim profile As String
    On Error GoTo 0
    Dim fd As FileDialog
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif;*.png"
        .ButtonName = "Select"
        .AllowMultiSelect = False
        .Title = "Choose Photo"
        .InitialView = msoFileDialogViewDetails
        .Show
    End With
    ActiveSheet.Range("A1").Select
    
    With ActiveSheet.Shapes.AddPicture(fd.SelectedItems(1), LinkToFile:=False, SaveWithDocument:=True)
        
        .Left = ActiveSheet.Range("photograph1").Left
        .Top = ActiveSheet.Range("photograph1").Top
        .Placement = 1
        .PrintObject = True
        profile = .Name
    End With
    ActiveSheet.Pictures(profile).Select
    With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .Width = 158
        .Height = 142
    End With
    ActiveSheet.Protect Password:="Password"
End Sub

But when I run the code I get the following error:

Run time error 450: Wrong number of arguments or invalid property assignment.

Any help once again much appreciated, as I really need to get this issue nailed down.

Kind Regards
Darren

 

[Domenic]

The left, top, width and height parameters for AddPicture must be specified. So you can replace...

    With ActiveSheet.Shapes.AddPicture(fd.SelectedItems(1), LinkToFile:=False, SaveWithDocument:=True)
        
        .Left = ActiveSheet.Range("photograph1").Left
        .Top = ActiveSheet.Range("photograph1").Top
        .Placement = 1
        .PrintObject = True
        profile = .Name
    End With
    ActiveSheet.Pictures(profile).Select
    With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .Width = 158
        .Height = 142
    End With

with

    [COLOR=darkblue]With[/COLOR] ActiveSheet.Shapes.AddPicture(Filename:=fd.SelectedItems(1), _
                                       LinkToFile:=msoFalse, _
                                       SaveWithDocument:=msoTrue, _
                                       Left:=ActiveSheet.Range("photograph1").Left, _
                                       Top:=ActiveSheet.Range("photograph1").Top, _
                                       Width:=158, _
                                       Height:=142)
        .Placement = 1
        .ControlFormat.PrintObject = [COLOR=darkblue]True[/COLOR]
        .LockAspectRatio = msoFalse
        profile = .Name
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]

Hope this helps!

 

[RoryA]

Note: you can specify -1 for both width and height to get the natural image proportions.

 

[Domenic]

Note: you can specify -1 for both width and height to get the natural image proportions.

Yeah, I ran across your article. Cool.

 

[ryu1200]

Brilliant Domenic, that works a treat, I cannot thank you enough as I was getting nowhere fast!

 

[Domenic]

You're very welcome!

Cheers!