Vba : Excel File Can't Save Picture Within The File It Self

[muhammad susanto]

hi all.
i have macro code to insert picture from a folder. The code work properly.
i have problem, after running code the pict is displayed but then when save the file then the new file opened the other device/pc/notebook the picture not "show " and show message "The linked image cannot be displayed. The file may have been moved, renamed or deleted. Verify that the link points to the correct file and location."
I need the code to be able to save the picture within the file itself. Here is the code for the macro:

Sub InsertPicture_r2()

    Const cBorder As Double = 5     ' << change as required
   
    Dim sPicture As String, pic As Picture
   
    sPicture = Application.GetOpenFilename("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", , "Select Picture to Import")
   
    If sPicture = "False" Then Exit Sub
   
    Set pic = ActiveSheet.Pictures.Insert(sPicture)
    With pic
        .ShapeRange.LockAspectRatio = False       ' << change as required
       
        If Not .ShapeRange.LockAspectRatio Then
            .Width = ActiveCell.MergeArea.Width - (2 * cBorder)
            .Height = ActiveCell.MergeArea.Height - (2 * cBorder)
        Else
            If .Width >= .Height Then
                .Width = ActiveCell.MergeArea.Width - (2 * cBorder)
            Else
                .Height = ActiveCell.MergeArea.Height - (2 * cBorder)
            End If
        End If
        .Top = ActiveCell.MergeArea.Top + cBorder
        .Left = ActiveCell.MergeArea.Left + cBorder
        .Placement = xlMoveAndSize
    End With
   
    Set pic = Nothing
End Sub

maybe this link related can solve my problem

Excel 2010 Macro Changes? - Microsoft: Office

Was wondering if the macro coding has changed in the 2010 version of Excel. We have a workbook with several macros in it. A few of these macros are for adding pictures to the workbook. The code in the macros works for Excel 2003 and 2007, but doesn't do as it should in 2010. The problem we are...

www.tek-tips.com

how to fix it the problem and maybe modified my code above.

any help, greatly appreciated..
note I'm use Office 2010
.sst

 

[yky]

You want to use .AddPicture instead of Pictures.Insert, which, I believe, has been deprecated.

Set pic = Activesheet.Shapes.AddPicture (Filename:=sPicture, LinkToFile:=False, SaveWithDocument:=True, a,b,c,d)
where a is left, b top, c width, d height of the picture to be added.

 

[muhammad susanto]

'You want to use .AddPicture instead of Pictures.Insert, which, I believe, has been deprecated.

Set pic = Activesheet.Shapes.AddPicture (Filename:=sPicture, LinkToFile:=False, SaveWithDocument:=True, a,b,c,d)
where a is left, b top, c width, d height of the picture to be added.

hi..
i have added your code like this

Set pic = ActiveSheet.Shapes.AddPicture(Filename:=sPicture, LinkToFile:=False, SaveWithDocument:=True)

but the result "runtime error 450" wrong number...........
how to make it working well..? please, completed into my above code.

 

[yky]

hi..
i have added your code like this

Set pic = ActiveSheet.Shapes.AddPicture(Filename:=sPicture, LinkToFile:=False, SaveWithDocument:=True)

but the result "runtime error 450" wrong number...........
how to make it working well..? please, completed into my above code.

Where are a, b, c, and d? You need to supply those parameters. a and b are the coordination of the picture (where to add the picture, a is left, b is top), c and d are the size of the picture (width and height). You know them. I don't.

 

[muhammad susanto]

hi all..
i'm still confused use or adapt the code within in my code before

Set pic = Activesheet.Shapes.AddPicture (Filename:=sPicture, [I]LinkToFile:=False, [I]SaveWithDocument:=True,[/I] a,b,c,d)
where a is left, b top, c width, d height of the picture to be added.[/I]

how to adapt with or adjusted with the below code

Sub InsertPicture_r2()

    Const cBorder As Double = 5     ' << change as required
  
    Dim sPicture As String, pic As Picture
  
    sPicture = Application.GetOpenFilename("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", , "Select Picture to Import")
  
    If sPicture = "False" Then Exit Sub
  
    Set pic = ActiveSheet.Pictures.Insert(sPicture)
    With pic
        .ShapeRange.LockAspectRatio = False       ' << change as required
      
        If Not .ShapeRange.LockAspectRatio Then
            .Width = ActiveCell.MergeArea.Width - (2 * cBorder)
            .Height = ActiveCell.MergeArea.Height - (2 * cBorder)
        Else
            If .Width >= .Height Then
                .Width = ActiveCell.MergeArea.Width - (2 * cBorder)
            Else
                .Height = ActiveCell.MergeArea.Height - (2 * cBorder)
            End If
        End If
        .Top = ActiveCell.MergeArea.Top + cBorder
        .Left = ActiveCell.MergeArea.Left + cBorder
        .Placement = xlMoveAndSize
    End With
  
    Set pic = Nothing
End Sub

i want to still use parameter this

.Width = ActiveCell.MergeArea.Width - (2 * cBorder)
            .Height = ActiveCell.MergeArea.Height - (2 * cBorder)
        Else
            If .Width >= .Height Then
                .Width = ActiveCell.MergeArea.Width - (2 * cBorder)
            Else
                .Height = ActiveCell.MergeArea.Height - (2 * cBorder)
            End If
        End If
        .Top = ActiveCell.MergeArea.Top + cBorder
        .Left = ActiveCell.MergeArea.Left + cBorder

would you help me

 

[Marc L]

Hi,​

​

the weird thing is on my side whatever the computer I used Pictures.Insert is the way to go !​

​

Maybe proceed an easy test : activate first the Macro Recorder then insert manually an image​

but with paying attention to the option via the down arrow icon …​

 

[muhammad susanto]

my problem is when my pictures have been inserted into my cell and pictures show look good. But One day i have sent my file to someone, the actually picture not showing in my friend.

 

[Marc L]

​

As I can't reproduce your issue using Pictures.Insert …​

​

So you must try Shapes.AddPicture as explained in VBA help and in posts #2 & 4 as well …​

 

[muhammad susanto]

yes..i have try use shapes.addpicture but still wrong
Set pic = ActiveSheet.shapes.addpicture
show "run time error 450......."

 

[Marc L]

​

As well explained whatever in VBA help - a must read ! - or in posts #2 & 4 you must add all its necessary parameters …​

​

​