Question

我使用以下代码选择并删除文档中的所有自动形状行。

它在MSWord 2003中运行良好。（也适用于2007年开放时使用2003绘制的线条）但它没有选择在MS Word 2007中绘制的线条。

Sub line() 
Dim shp As Shape, intBoxNbr As Integer

intNbrShapes = 0
For Each shp In ActiveDocument.Shapes
If shp.Type = msoLine Then
intNbrShapes = intNbrShapes + 1
ActiveWindow.ScrollIntoView Selection.Range, True
shp.Select
Selection.Delete
'shp.Delete
'(Selection.Delete is used in MSWord 2007 and shp.Delete used in MSWord 2003)
End If
Next shp

End Sub

我发现在MSword 2007中绘制的行的名称为Autoshape ##，其中2003的行为##。我在文档中有其他自动形状（文本框等），所以我不能只使用＆＃34;如果shp.Type = msoAutoShape那么＆＃34;。请帮助如何选择并删除使用MS word 2007绘制的线条。

感谢。

我现在更新了代码......它没有立即删除所有行。我需要多次运行宏来删除所有宏。

Sub Macro1()
'
' Macro1 Macro
'
Dim shp As Shape, i As Integer

i = 0
For Each shp In ActiveDocument.Shapes
If shp.Type = msoAutoShape Then
i = i + 1
ActiveWindow.ScrollIntoView Selection.Range, True
shp.Select

If Selection.ShapeRange.Line.DashStyle = msoLineSolid Then
Selection.Delete
End If

'shp.Delete

End If
Next shp

End Sub

Answer 1

从集合中删除项目时，必须以 reverse 顺序执行此操作。这是因为集合已编入索引。请考虑以下示例集合：

Item#  Name
  1      David
  2      Sergio
  3      Beatrice
  4      Eunice

如果我们尝试通过从1到.Count的直接迭代删除所有项目，它将无法工作：

Sub foo()
Dim coll As New Collection
Dim i As Integer

coll.Add 1, "David"
coll.Add 2, "Sergio"
coll.Add 3, "Beatrice"
coll.Add 4, "Eunice"

For i = 1 To coll.Count
    coll.Remove (i)
Next

MsgBox coll.Count

End Sub

在第一次迭代中，i = 1，它将删除“David”，在第二次传递时，i = 2，但由于项目1先前被删除，第二个索引现在是“Beatrice”，所以“Sergio”是跳过。在第三次迭代中，i = 3，但集合中不再有3个项目，您将收到错误！（下标超出范围）。如果您还没有遇到错误，那是可能的。

所以，为了避免这个问题，你需要倒退：

For i = coll.Count to 1 Step -1
    coll.Remove(i)
Next

这意味着您必须使用索引迭代而不是For Each，以便适应您的代码，您可以尝试：

For i = ActiveDocument.Shapes.Count to 1 Step - 1
    Set shp = ActiveDocument.Shapes(i)

    If shp.Type = msoAutoShape Then

        ActiveWindow.ScrollIntoView Selection.Range, True
        shp.Select

        If Selection.ShapeRange.Line.DashStyle = msoLineSolid Then
            Selection.Delete
        End If
    End If
Next

Answer 2

这个有效

Sub Macro2()
'
' Macro2 Macro
'
'
    Dim shp As Shape, i As Integer

i = 0

For i = ActiveDocument.Shapes.Count To 1 Step -1
    Set shp = ActiveDocument.Shapes(i)

    If shp.Type = msoAutoShape Then

        ActiveWindow.ScrollIntoView Selection.Range, True
        shp.Select

        If Selection.ShapeRange.Line.DashStyle = msoLineSolid Then
            Selection.Delete
        End If
    End If
Next

End Sub

word 2007 vba无法一次删除所有自动形状行

2 个答案: