3

背景
这与问题ms word 2010 宏如何选择特定页面上的所有形状密切相关。但这涉及我ShapeRange.Delete在尝试为该问题编写答案时得到的意外结果。

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

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

但是，当我运行第二个代码块时，我得到了不稳定的行为。有时会删除正确的形状。有时他们不是。我可能会在运行代码后绘制或按 ctrl-click-copy 形状，然后再次运行，但我找不到使代码按预期停止工作的模式。即使形状没有移动，也会发生这种情况。简而言之，只是代码发生了变化，但该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
4

1 回答 1

4

由于您删除形状的方式，问题很可能发生。从 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

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

于 2013-09-17T20:34:11.747 回答