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

muhammad susanto

Well-known Member
Joined
Jan 8, 2013
Messages
2,077
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
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:
VBA 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
maybe this link related can solve my problem
how to fix it the problem and maybe modified my code above.

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

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
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.
 
Upvote 0
'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
VBA Code:
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.
 
Last edited:
Upvote 0
hi..
i have added your code like this
VBA Code:
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.
 
Upvote 0
hi all..
i'm still confused use or adapt the code within in my code before
VBA Code:
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
VBA 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
VBA Code:
.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
 
Upvote 0
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 …​
 
Upvote 0
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.
 
Upvote 0
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 …​
 
Upvote 0
yes..i have try use shapes.addpicture but still wrong
Set pic = ActiveSheet.shapes.addpicture
show "run time error 450......."
 
Upvote 0
As well explained whatever in VBA help - a must read ! - or in posts #2 & 4 you must add all its necessary parameters …​
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,700
Members
448,293
Latest member
jin kazuya

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top