Convert whole shape to image in Ms word using macro

I am writing this macro to convert all shapes in a document to an image:

Sub AllShapeToPic()    
   For Each oShp In ActiveDocument.Shapes
    oShp.Select
    Selection.Cut
    Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
   Next oShp

End Sub

      

But when I run it, none of the shapes are converted to an image.
What's wrong with my macro code?

+1


source to share


1 answer


Welcome to the wonderful world of manipulating the very collection that you iterate over. The moment you cut, you are effectively removing the shape from the collection by changing your loop.

If you want to iterate over shapes (or table rows or whatever) and delete something from this collection, just go back:

Dim i As Integer, oShp As Shape

For i = ActiveDocument.Shapes.Count To 1 Step -1
    Set oShp = ActiveDocument.Shapes(i)
    oShp.Select
    Selection.Cut
    Selection.PasteSpecial Link:=False, dataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
Next i

      

Alternative for tables (warning: untested!)



Dim tbl As Table

For i = ActiveDocument.Tables.Count To 1 Step -1
    Set tbl = ActiveDocument.Tables(i)
    tbl.Select
    Selection.Cut
    Selection.PasteSpecial Link:=False, dataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
Next i

      

For Equations: Equations are InlineShapes and have the "OMath" property. Use it to identify the object of the equation. Warning: unverified

Dim equation As InlineShape

For i = ActiveDocument.InlineShapes.Count To 1 Step -1
    Set equation = ActiveDocument.InlineShapes(i)
    If equation.OMath > 0 Then
        equation.Select
        Selection.Cut
        Selection.PasteSpecial Link:=False, dataType:=wdPasteEnhancedMetafile, _
            Placement:=wdInLine, DisplayAsIcon:=False
    End If
Next i

      

+3


source







All Articles