How to save Word Shapes to image using VBA?

Question

I have a simple requirement to save MS-Office Drawing Objects embedded within a Word Doc to image files. The following code worked for image extraction from Powerpoint. However it does not work for MS-Word if I modify the ActivePresentation to ActiveDocument. The Export method was not available for shape object. Any ideas?

Dim oPPTShap as Shape
For k = 1 To .Slides(intSlide).Shapes.Count
    Set oPPTShape = ActivePresentation.Slides(intSlide).Shapes(k)
    oPPTShape.Export "C:\images\s" & k & ".bmp", ppShapeFormatBMP                
Next

Answer 1

This is not great, as it outputs each image in EMF format, but it does write each of the images in the inline shapes collection to an individual file. It could of course be modified to do the other shapes collection.

I would like to enhance to to write JPG directly, but so far do not know the VBA to push WRITE output through a filter on the way. Therefore, to use these files you need to run some outboard post-process/batch to covert the files from EMF to something more usable.

Sub WriteInlineShapesToFile()
    Dim docCurrent As Document
    Dim shapeCurrent As InlineShape
    Dim RC As Integer
    Dim vData() As Byte
    Dim i As Long
    Dim lWritePos As Long
    Dim strOutFileName As String

    Set docCurrent = ActiveDocument

    i = 1

    For Each shapeCurrent In docCurrent.InlineShapes
        strOutFileName = "c:\temp\datafile" & CStr(i) & ".emf"
        Open strOutFileName For Binary Access Write As #1
        i = i + 1
        vData = shapeCurrent.Range.EnhMetaFileBits
        lWritePos = 1

        Put #1, lWritePos, vData

        Close #1

 Next shapeCurrent

    RC = MsgBox("Job complete.", vbOKOnly, "Job Status")

End Sub

Answer 2

The code you are trying to copy from PPT VBA to Word VBA won't work because the functionality does not exist in Word.

You can try by yourself : when you select shapes in Word and right-click, you do not have the function to Save as image... (versus in PPT you do have the function).

Yet, from this page, the author points to a MVP who built a VBA solution to do what you want : http://www.lebans.com/msword.htm

Hope it will do what you want,

Answer 3

Here is one dirty (and fastest) trick that I can think of :D

Save the word document to a temp folder as a webpage. Something like

ActiveDocument.SaveAs FileName:="C:\Temp\Sample.htm", FileFormat:=wdFormatHTML, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False

All the shapes and pictures in the word document will be automatically saved in the folder called C:\Temp\Sample_Files

You then then simply delete all the files in that folder which are not images :)

Let me know if you want to pursue this option :)

Sid

EDIT

Gosh I just realized it is an old thread. Hmm, all thanks to "Joel Coehoorn" for editing this thread LOLZ

Answer 4

This function can be used to save all inlineshapes in a Word document to disk. It does not rely on calls to DLL functions, but uses WordXML to access a base64 version of the image, which is then saved to disk.

Private Sub WriteInlineShapesToFile()
    Dim k As Integer
    For k = 1 To ActiveDocument.InlineShapes.count
        saveImage ActiveDocument.InlineShapes(k), "C:\images\s" & k & ".png"
    Next
End Sub

Private Sub saveImage(shp As InlineShape, path As String)

    Dim s As String
    Dim r As Range
    Dim i As Long
    Dim j As Long
    
    s = shp.Range.WordOpenXML
   
    i = InStr(s, "<pkg:binaryData>")
    
    If i = 0 Then
        Set r = shp.Range.Duplicate
        r.End = r.End + 1
        s = r.WordOpenXML
        i = InStr(s, "<pkg:binaryData>")
        If i = 0 Then
            r.start = r.start - 1
            s = r.WordOpenXML
            i = InStr(s, "<pkg:binaryData>")
            If i = 0 Then
                MsgBox "No binary data found"
                Exit Sub
            End If
        End If
    End If
    
    ''move i to end of "<pkg:binaryData>"
    i = i + 16

    j = InStr(i, s, "</pkg:binaryData>")
    
    s = Mid$(s, i, j - i)
    
    Dim DecodeBase64() As Byte
    Dim objXML As Object 'MSXML2.DOMDocument
    Dim objNode As Object 'MSXML2.IXMLDOMElement

    Set objXML = CreateObject("MSXML2.DOMDocument")

    'create node with type of base 64 and decode
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.Text = s
    DecodeBase64 = objNode.nodeTypedValue

    Set objNode = Nothing
    Set objXML = Nothing

    Open path For Binary As #1
        Put #1, 1, DecodeBase64
    Close #1

End Sub

Answer 5

Okay, this is not a solution, but a different approach to an old problem. So far I've come across lots of examples that either save the file out to a .HTML and then grab the images from a subfolder of the HTML document, or code that extracts the document archive and then grabs the files from the extracted set.

How about this:

1. Iterate through the Inline Shapes of the document if you're in Word.

2. For each Inline Shape:

   a. Copy the image data to the clipboard. You've already got the other metadata of the image as you've obtained it via the object model in VBA.

   b. You can copy the image for say the first Inline Shape like this:

   ActiveDocument.InlineShapes(1).Range.CopyAsPicture
   

   c. Now that the image data is in the clipboard, it should be possible to get the data off the clipboard. I know VBA sucks with this, but you should be able to use the Windows API to work around that. If you can somehow get the image data back, you can write it to a file with the metadata that you've obtained from the object model.

Answer 6

You can also write a PowerPoint macro inside word, if you add Microsoft Powerpoint to Word VBA References and define a Powerpoint application object in word.

So you can take advantage of PP export capabilities:

just select the shape in word, copy it to clipboard (selection.copy) , and paste it into an empty presentation in PP.