删除画布，保留内容

sharpspear

文档很长，现在想把文中的画布全部删除然后保留内部的内容，写了一段vba，可以成功，可是效率特别低（因为是遍历文档内的所有图形，但是我文档内的行内图形（公式）特别多有数千之多，想改为遍历画布图形），长文档会死机，求教大虾如何更改。

Sub pic()'删除画布，保留内容
Dim n
On Error Resume Next
For n = 1 To ActiveDocument.Shapes.Count
With ActiveDocument.Shapes(n)
.CanvasItems.SelectAll
Selection.Copy
.Delete
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.ShapeRange.Group.WrapFormat.Type = wdWrapTopBottom
Selection.ShapeRange.Ungroup
End With
Next n
End Sub