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,