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 to share