Word VBA:ShapeRange.Delete 意外行为 [英] Word VBA: ShapeRange.Delete unexpected behavior
问题描述
背景
这与问题 ms word 2010 宏如何选择特定页面上的所有形状.但这涉及到我在尝试为该问题编写答案时从 ShapeRange.Delete 得到的意外结果.
The Background
This is closely related to the question ms word 2010 macro How to select all shapes on a specific page. But this concerns an unexpected result I'm getting from ShapeRange.Delete, when trying to code an answer for that question.
问题
所以，设置问题.我可以更改每个页面上第一个和最后一个形状的属性.但是，当我将更改形状属性的语句 (shp.Range.ShapeRange.Line.Weight = 10) 替换为删除形状的语句 (shp.Range.ShapeRange.Delete)，删除与更改属性的形状不对应的形状.为什么 .Delete 与 .Line.Weight 的形状不同?
The Question
So, to set up the question. I'm able to change properties of the first and last shape on each page. However, when I replace the statement that changes the shape property (shp.Range.ShapeRange.Line.Weight = 10) with a statement that deletes the shape (shp.Range.ShapeRange.Delete), shapes are deleted that do not correspond to the shapes that had the property changed. Why does .Delete not act on the same shapes as .Line.Weight?
也许我找错地方了?
这里发生了一些奇怪的事情.我正在处理启用了宏的 2007 Word .docm 文档.该文档是 9 页文本，通过复制 SO 页面并使用选择性粘贴...无格式文本粘贴到新文档中而创建.然后我画了一些形状——我得到了类似的矩形、三角形和椭圆形的结果.没有形状是内联的.我可以按住 ctrl 单击某些形状来复制它们.但每一次，第一个代码块都能完美运行:每个页面的顶部和底部形状都有一个粗体轮廓.即使我四处移动形状，当我再次运行代码时，也只有每个页面上的顶部和底部形状具有粗体轮廓.
Maybe I'm looking in the wrong place?
There are a few strange things happening here. I'm working on a 2007 Word .docm document with macros enabled. The document is 9 pages of text created by copying a SO page and pasting into the new fresh document with Paste Special...Unformatted Text. I then draw some shapes - I've gotten similar results with rectangles, triangles, and ovals. No shapes are inline. I may ctrl-click some shapes to duplicate them. But every time, the first code block works perfectly: the top and bottom shapes on each page have a bold outline. Even if I move shapes around, when I run the code again only the top and bottom shapes on each page have a bold outline.
然而，当我运行第二个代码块时，我得到了不稳定的行为.有时会删除正确的形状.有时他们不是.我可能会在运行代码后绘制或按住 ctrl 单击复制形状，然后再次运行，但我找不到使代码按预期停止工作的模式.即使不移动形状，也会发生这种情况.简而言之，只是代码发生了变化，但 ShapeRange.Delete 方法似乎以一种意想不到的方式起作用.
However, when I run the second code block I get erratic behavior. Sometimes the correct shapes are deleted. Sometimes they're not. I may draw or ctrl-click-copy shapes after running code, then run again, but I can't find a pattern to what makes the code stop working as expected. This occurs even when the shapes are not moved. In short, nothing but the code changes, yet it seems the ShapeRange.Delete method is acting in an unexpected way.
两套代码
这是更改形状属性的代码:
The two sets of code
Here's the code that changes the shape properties:
'---------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 的形状！
And, if I modify the code such (only in the last For...Next loop, see the comment), different shapes are deleted, even leaving some shapes that have a 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
推荐答案
问题很可能是由于您删除形状的方式造成的.在 vba 中从对象集合中删除项目时，您需要从最后一个对象开始，然后朝着集合中的第一个对象前进.您的代码:
The problem is most likely occurring because of the way that you are deleting your shapes. When deleting items from a collection of objects in vba, you need to start with the last object and work your way toward the first object in the collection. Your code:
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
这是必要的，因为一旦你删除第一个对象，集合就会重新索引自己，现在以前的第二个对象是第一个对象，依此类推.
This is necessary, because as soon as you delete the first object, the collection will re-index itself, and now the formerly 2nd object is the 1st object and so on.
这篇关于Word VBA:ShapeRange.Delete 意外行为的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
