Weird Shape Issue

[gmaxey]

I have a document with a single table and two textboxes anchored to differet cell ranges. I want to convert the table to text ane then put the textbox text at its anchor point and delete the textboxes.

TestI and ExtractTextBoxTextI was my first attempt and I can't figure out why Word just breezes past the second textbox and doens't process it!

TestII and ExtractTextBoxTextII work as expected. Still baffled by the first attempt. Anyone got any ideas why it doesn't work?

Option Explicit
Sub TestI()
Dim oRngX As Word.Range
Set oRngX = ActiveDocument.Tables(1).Range
ActiveDocument.Tables(1).ConvertToText vbCr, True
ExtractTextBoxTextI oRngX
End Sub
Sub ExtractTextBoxTextI(ByRef oRngTP As Word.Range)
Dim oShp As Word.Shape
Dim strText As String
Dim oRngAnchor As Word.Range
Dim lngIndex As Long
Debug.Print oRngTP.ShapeRange.Count
For Each oShp In oRngTP.ShapeRange
If oShp.Type = msoTextBox Then
oShp.Name = "TroublesomeTB_" & lngIndex
lngIndex = lngIndex + 1
End If
Next oShp
Debug.Print ActiveDocument.Shapes.Count
For Each oShp In ActiveDocument.Shapes
Set oShp = ActiveDocument.Shapes(lngIndex)
If InStr(oShp.Name, "TroublesomeTB_") > 0 Then
strText = oShp.TextFrame.TextRange.Text
Set oRngAnchor = oShp.Anchor
oRngAnchor.InsertAfter vbCr & strText
oShp.Delete
End If
Next oShp
Debug.Print ActiveDocument.Shapes.Count
End Sub
Sub TestII()
Dim oRngX As Word.Range
Set oRngX = ActiveDocument.Tables(1).Range
ActiveDocument.Tables(1).ConvertToText vbCr, True
ExtractTextBoxTextII oRngX
End Sub
Sub ExtractTextBoxTextII(ByRef oRngTP As Word.Range)
Dim oShp As Word.Shape
Dim strText As String
Dim oRngAnchor As Word.Range
Dim lngIndex As Long
Debug.Print oRngTP.ShapeRange.Count
For Each oShp In oRngTP.ShapeRange
If oShp.Type = msoTextBox Then
oShp.Name = "TroublesomeTB_" & lngIndex
lngIndex = lngIndex + 1
End If
Next oShp
Debug.Print ActiveDocument.Shapes.Count
For lngIndex = ActiveDocument.Shapes.Count To 1 Step -1
Set oShp = ActiveDocument.Shapes(lngIndex)
If InStr(oShp.Name, "TroublesomeTB_") > 0 Then
strText = oShp.TextFrame.TextRange.Text
Set oRngAnchor = oShp.Anchor
oRngAnchor.InsertAfter vbCr & strText
oShp.Delete
End If
Next lngIndex
Debug.Print ActiveDocument.Shapes.Count
End Sub

[gmaxey]

Of course since the issue appears to be related to the For Each oShp ... Next,

A working procedure can be reduced to:

Sub TestIII()
Dim oRngX As Word.Range
Set oRngX = ActiveDocument.Tables(1).Range
ActiveDocument.Tables(1).ConvertToText vbCr, True
ExtractTextBoxTextII oRngX
End Sub
Sub ExtractTextBoxTextIII(ByRef oRngTP As Word.Range)
Dim oShp As Word.Shape
Dim strText As String
Dim oRngAnchor As Word.Range
Dim lngIndex As Long
For lngIndex = oRngTP.ShapeRange.Count To 1 Step -1
Set oShp = oRngTP.ShapeRange(lngIndex)
If oShp.Type = msoTextBox Then
strText = oShp.TextFrame.TextRange.Text
Set oRngAnchor = oShp.Anchor
oRngAnchor.InsertAfter vbCr & strText
oShp.Delete
End If
Next lngIndex
End Sub

[macropod]

Hi Greg,

Using 'For each' loops to delete objects from a collection tends to result in only every second object being processed, I suppose for much the same reason that using a 'For i = 1 to .Count' loop does.

[gmaxey]

Paul,

Thanks. In my former Navy life this is one of those things we would call "Lesson Relearned." I knew that, but it completely siipped my mind. I was being lazy when I wrote the code and when it didn't work I spent more time wondering why than I would have if I would have done it the right way to begin with :-(