• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 4376
  • Last Modified:

Adding picture to Word document using Excel -VBA generates out-of-memory error.

Using VBA in Excel 2003, I open a Word document using a template. After filling in fields and creating custom document properties in the document, I try to add a bitmap. I've tried to add it two different ways: 1) executing the AddPicture statement directly from Excel and 2) having Excel run  a routine in the Word document that has the AddPicture statement in it.  Here is the statement (SHP is declared as a WORD.Shape)

Set SHP = ActiveDocument.Shapes.AddPicture  _
(PicFile,False, True,300,-26, , ,ActiveDocument.Bookmarks("bkSIG").Range)

As soon as the statement is executed, I get the error  "There is insufficient memory. Save the document now." I've tried changing the Link and SaveWithFile parameters and eliminated the placement parameters, but nothing works. I tried it adding a 240k BMP  file and a 20k JPG file.

I can switch to the Word document and execute the routine inside the Word document directly (without closing any other programs) and it works fine . I'm running SP3 for Office 2003 on a 2-gig machine under Windows XP SP2 with more than 80 gigs of available disk space. I've researched the error message extensively, but haven't found any relelvant solutions.

  • 4
  • 4
1 Solution
William ElliottSr Tech GuruCommented:
what does the code below do for you?
Sub CreateNewWordDoc()
' to test this code, paste it into an Excel module
'******important******>> add a reference to the Microsoft word object library
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim i As Integer
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Add ' create a new document
'here is where it inserts the image.
        wrdApp.Selection.InlineShapes.AddPicture Filename:= _
        "C:\Documents and Settings\Administrator\Desktop\escher[1].jpg", _
        LinkToFile:=False, SaveWithDocument:=True
'this just adds some text to it
    With wrdDoc
        For i = 1 To 10
            .Content.InsertAfter "Here is a example test line #" & i
        Next i
'this will delete the existing file and recreate a new one
        If Dir("C:\Scripts\MyNewWordDoc.doc") <> "" Then
            Kill "C:\Scripts\MyNewWordDoc.doc"
        End If
        .SaveAs ("C:\Scripts\MyNewWordDoc.doc")
        .Close ' close the document
    End With
    wrdApp.Quit ' close the Word application
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
End Sub

Open in new window

William ElliottSr Tech GuruCommented:
heh,.. you'll have to change the image that it inserts.. i'm sure you don't have the same one,.... also you will need to change the folder location(unless you have a scripts folder)
jhseymour113Author Commented:
Adding the InLineShape worked (no error). However the InLineShape has very different properties from Shape. Positioning the bitmap relative to an anchor is critical for me. I tried converting the InLineShape to a Shape, but when I try to set the anchor, it deletes the picture.  Unfortunately, the problem is not solved yet.
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

jhseymour113Author Commented:
OK, after playing with a zillion other properties of the Shape object, I discovered a way to re-set the anchor. All worked perfectly within Word. Then I ran from Excel again and this time I get this error from Word:

"The graphics filter was unable to convert this file"

There's no problem inserting this file when running directly in Word.
William ElliottSr Tech GuruCommented:
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
Dim shp As Shape
Set shp = wrdApp.ActiveDocument.Shapes.AddPicture(picfile, False, True, 300, -26, , , ActiveDocument.Bookmarks("bkSIG").Range)
jhseymour113Author Commented:
Sorry, I don't understand what you're suggesting here. This is pretty much the code I already had.
William ElliottSr Tech GuruCommented:
hmm,. ok
can you upload what you have so i can take a look at it and make modifications directly?

jhseymour113Author Commented:
In trying to strip down the code to give you the bare essentials, I found the problem in a most unlikely place. Using the InlineShape and then converting to a Shape was still necessary. The second error ("Graphics fileter was unable to convert ...") was generated because the filename was presented from a table with quotes around it making it an invalid file name. Everything now seems to be working and I happily award you all the points. Solution accepted! Just having someone to dialog with made all the difference. Thanks much.

By the way, here is the Word code that does the trick:

Public Sub InsertTheSig()
    Dim SHP1 As InlineShape, SHP As Shape, PicFil As String
    Selection.GoTo wdGoToBookmark, , , "bkSIG"
    Selection.Collapse wdCollapseEnd
    'PicFil = "C:\temp\stevenjamzler.bmp"   '
    PicFil = ActiveDocument.CustomDocumentProperties("ApprovedBy")
    Set SHP1 = Application.Selection.InlineShapes.AddPicture _
        (FileName:=PicFil, linkToFile:=False, SaveWithDocument:=True)

    Set SHP = SHP1.ConvertToShape
    'SHP.Anchor = ActiveDocument.Bookmarks("bkSIG").Range
    SHP.Name = "Sig"
    Selection.ShapeRange.LayoutInCell = True
    Selection.ShapeRange.WrapFormat.AllowOverlap = True
    Selection.ShapeRange.WrapFormat.Type = wdWrapMergeThrough
    Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
    Selection.ShapeRange.WrapFormat.DistanceTop = InchesToPoints(0)
    Selection.ShapeRange.WrapFormat.DistanceBottom = InchesToPoints(0)
    Selection.ShapeRange.WrapFormat.DistanceLeft = InchesToPoints(0.13)
    Selection.ShapeRange.WrapFormat.DistanceRight = InchesToPoints(0.13)
    'Selection.ShapeRange.ZOrder 4
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Rotation = 0#
    Selection.ShapeRange.PictureFormat.Brightness = 0.5
    Selection.ShapeRange.PictureFormat.Contrast = 0.5
    Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
    Selection.ShapeRange.PictureFormat.CropLeft = 0#
    Selection.ShapeRange.PictureFormat.CropRight = 0#
    Selection.ShapeRange.PictureFormat.CropTop = 0#
    Selection.ShapeRange.PictureFormat.CropBottom = 0#

    Selection.ShapeRange.RelativeHorizontalPosition = _
    Selection.ShapeRange.RelativeVerticalPosition = _

    Selection.ShapeRange.LockAnchor = False
    SHP.LockAnchor = False
    SHP.Anchor.SetRange  _
ActiveDocument.Bookmarks("bkSIG").Range.Start, ActiveDocument.Bookmarks("bkSIG").Range.End

    SHP.Left = 300
    SHP.Top = -26
End Sub
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 4
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now