vba - Word VBA : ShapeRange. 删除意外行为

Question

背景
这与问题ms word 2010 macro How to select all shapes on a specific page密切相关。 。但这涉及到我在尝试编写该问题的答案时从 ShapeRange.Delete 得到的意外结果。

问题
所以，提出这个问题。我可以更改每个页面上第一个和最后一个形状的属性。但是，当我将更改形状属性的语句 (shp.Range.ShapeRange.Line.Weight = 10) 替换为删除形状的语句 (shp.Range.ShapeRange.Delete )，与属性已更改的形状不对应的形状将被删除。 为什么 .Delete 不能作用于 .Line.Weight 相同的形状？

也许我找错地方了？
这里发生了一些奇怪的事情。我正在处理启用了宏的 2007 Word .docm 文档。该文档是 9 页文本，通过复制 SO 页面并使用粘贴特殊...未格式化文本粘贴到新文档中而创建。然后我画了一些形状——我用矩形、三角形和椭圆形得到了类似的结果。没有形状是内联的。我可以按住 Ctrl 键单击某些形状来复制它们。但每次，第一个代码块都能完美运行:每个页面的顶部和底部形状都有粗体轮廓。即使我移动形状，当我再次运行代码时，只有每个页面上的顶部和底部形状有粗体轮廓。

但是，当我运行第二个代码块时，我得到了不稳定的行为。有时正确的形状会被删除。有时他们不是。我可能会在运行代码后绘制或按住 Ctrl 键单击复制形状，然后再次运行，但我找不到使代码停止按预期工作的模式。即使形状未移动，也会发生这种情况。简而言之，只是代码发生了变化，但 ShapeRange.Delete 方法似乎以意想不到的方式运行。

两组代码
以下是更改形状属性的代码:

'---------find the first and last shape on each page, make bold-----------
Dim pg As Page
Dim shp As Variant
Dim shp_count As Long, maxt As Long, maxb As Long

'for each page
For Each pg In ActiveDocument.Windows(1).Panes(1).Pages

  'find the number of shapes
  shp_count = 0
  For Each shp In pg.Rectangles
    If shp.RectangleType = wdShapeRectangle Then shp_count = shp_count + 1
  Next

  'if there are more than 2 shapes on a page, there
  'are shapes to be made bold
  If shp_count > 2 Then

    'prime the maxt and maxb for comparison
    'by setting to the first shape
    For Each shp In pg.Rectangles
      If shp.RectangleType = wdShapeRectangle Then
        maxt = shp.Top
        maxb = maxt
        Exit For
      End If
    Next

    'set maxt and maxb
    For Each shp In pg.Rectangles
      If shp.RectangleType = wdShapeRectangle Then
        If shp.Top < maxt Then maxt = shp.Top
        If shp.Top > maxb Then maxb = shp.Top
      End If
    Next

    'Make top and bottom shapes bold outline
    For Each shp In pg.Rectangles
      If shp.RectangleType = wdShapeRectangle Then
        If shp.Top = maxt Or shp.Top = maxb Then
          shp.Range.ShapeRange.Line.Weight = 10
        Else
          shp.Range.ShapeRange.Line.Weight = 2
        End If
      End If
    Next

  End If
'go to next page
Next

并且，如果我修改代码(仅在最后一个 For...Next 循环中，请参阅注释)，则会删除不同的形状，甚至留下一些 line.weight = 10 的形状!

'---------find the first and last shape on each page, make bold-----------
Dim pg As Page
Dim shp As Variant
Dim shp_count As Long, maxt As Long, maxb As Long

'for each page
For Each pg In ActiveDocument.Windows(1).Panes(1).Pages

  'find the number of shapes
  shp_count = 0
  For Each shp In pg.Rectangles
    If shp.RectangleType = wdShapeRectangle Then shp_count = shp_count + 1
  Next

  'if there are more than 2 shapes on a page, there
  'are shapes to be made bold
  If shp_count > 2 Then

    'prime the maxt and maxb for comparison
    'by setting to the first shape
    For Each shp In pg.Rectangles
      If shp.RectangleType = wdShapeRectangle Then
        maxt = shp.Top
        maxb = maxt
        Exit For
      End If
    Next

    'set maxt and maxb
    For Each shp In pg.Rectangles
      If shp.RectangleType = wdShapeRectangle Then
        If shp.Top < maxt Then maxt = shp.Top
        If shp.Top > maxb Then maxb = shp.Top
      End If
    Next

    'Make top and bottom shapes bold outline
    For Each shp In pg.Rectangles
      If shp.RectangleType = wdShapeRectangle Then
        If shp.Top = maxt Or shp.Top = maxb Then
          'here's the modification, nothing else changed
          shp.Range.ShapeRange.Delete
          'shp.Range.ShapeRange.Line.Weight = 10
        Else
          shp.Range.ShapeRange.Line.Weight = 2
        End If
      End If
    Next

  End If
'go to next page
Next

Answer 1

该问题很可能是由于您删除形状的方式造成的。在 vba 中从对象集合中删除项目时，您需要从最后一个对象开始，然后逐步移向集合中的第一个对象。您的代码:

For Each shp In pg.Rectangles
 ....
      shp.Range.ShapeRange.Delete
 ....
Next

应阅读:

For i = pg.Rectangles.Count to 1 Step -1

 ....
      pg.Rectangles(i).Delete
 ....
Next

这是必要的，因为一旦删除第一个对象，集合就会重新索引自己，现在以前的第二个对象是第一个对象，依此类推。