Cycling through text boxes in Word

Topic

New Reply

Hellow,

Does anyone have macro code that will cycle through all the text boxes in all sections of a Word document?

Ed Colaianni
edc@post.harvard.edu

Reply | Quote

Replies

Hi Ed,

Textboxes ‘live’ in the drawing layer and are therefore members of the Shapes collection.

To cycle through all of them, you could use code like:

Sub CycleThroughTextBoxes()
Dim objShape As Shape
For Each objShape In ActiveDocument.Shapes
    If objShape.Type = msoTextBox Then
        'do the required action
    End If
Next objShape
End Sub

Hope this helps,
Gary

Reply | Quote

The loop posted does help somewhat, but it seems some of the text boxes are grouped and the loop doesnt find them.

The Word Command “Next Object” (alt-downarrow) does go to the individual boxes in the group, but it circles to the beginning when it hits a section break.

I am leery of ungrouping items, as I think it might be difficult to reestablish the same groups after doing find-replaces and field updates.

Ed Colaianni

Reply | Quote

Edited by Gary Frieder on 01/01/17 18:38.

The textbox grouping does add a complication, but perhaps not insurmountable.

(oops, didn’t read the last line in your response, first time round!)
It should still be possible to do the find replaces and field updates. I’ll try to post a more detailed answer later today, or perhaps in the meantime someone else will take a stab at it.

Reply | Quote

Hey Gary,

Off Topic, but I can’t find the it in the FAQ. What does the little U in your MVP icon stand for?

Reply | Quote

Kevin,

I thought that was a “V”?

For those who haven’t caught it yet, check the latest Woody’s Newsletter– Gary has become the latest MVP.

Congratulations Gary.

Reply | Quote

Ok, V. Looks like a U. But what does it stand of? I know the icon means MVP, but V?

Reply | Quote

Kevin,

I guess “M” was already taken. Lots of us have that one.

Probably V for Valued (Valuable?) is more important than M for Most or P for Person.

Reply | Quote

Multiple topics in a single thread, again.

Sorry about that. But thanks for the answer. Maybe an icon without a letter in it would be more appropriate for MVPs. A badge-like icon or that ‘ribbon’ icon in Blue (for 1st place) might have more meaning than V. Just a thought. You guys/gals work hard at this and deserve instant and on-going recognition in even the littlest icon! Thanks!!

Reply | Quote

Thanks a lot, Geoff.

I also have no idea what the banner means – we’ll have to ask The One Who Knows All (and Who Need Not Even Be Identified By Name).

BTW I think there are a number of other folks who should be considered for MVPs here; hopefully your name will be “in red” soon too!

Reply | Quote

Hi Ed,

This does turn very snarky very quick.
The following code will take care of the Fields update:

With ActiveDocument.StoryRanges(wdTextFrameStory)
.Fields.Update
End With

So, you might think you could put a standard Find/Replace routine in, before that End With – but no – it will replace the text in the first text box and stop there.
You can do this with Find/Replace in the user interface, but not readily via code. This seems like one of those ones where they left out a needed property or method in the Word VBA object model (for example, VBA is telling me the grouped text box object “Does not support text” – even though there is text in there!), and some very clever workaround is going to be necessary if it can be found at all.
I’ll try to play around some more next time I’m ‘off the clock’.

Gary

Reply | Quote

Updating all the fields is actually the most important right now, the find-replace is just to fix a few spelling errors involving hyphenated words.

Here is a loop from a freeware “count all words” macro that will ungroup all the groups. I would use it, but I dont know how put the groups back together after operating on the text:

‘ “Ungroup” all the shapes in the document so that we can look at the Text boxes
Do
lngI = 0
For Each shpTemp In AtiveDocument.Shapes
If shpTemp.Type = msoGroup Then
shpTemp.Ungroup
lngI = 1
End If
Next shpTemp
Loop Until lngI = 0

Ed Colaianni, edc@post.harvard.edu

Reply | Quote

Hi again,

As you note, ungrouping the textboxes is easy, the hard part is regrouping them, into the correct groupings, programatically.

(And to review for anyone for didn’t read the beginning of the thread, the original issue was trying to find/replace words in all of the textboxes in a document. If any of the textboxes are grouped, the find/replace won’t work on them, when run from code.)

The following seems to work right. The two tricky bits are: keeping count of the temporarily ungrouped textboxes (uses two counters), and regrouping the correct groupings. This last bit takes advantage of a quirk of the Selection object in Word, that lets you regroup something you ungrouped, by selecting only the first item in the group (and then regrouping).

Sub UngroupRegroupAll()
'Gary Frieder  January 2001
'Purpose:   Enable a find/replace on text in all textboxes in a document.
'           This requires temporarily ungrouping any grouped textboxes,
'           doing the find/replace, and then regrouping them.
Dim objDocShapes As Shapes
Dim lngGroupCt As Long
Dim n As Long
Dim c As Long
Set objDocShapes = ActiveDocument.Shapes
For n = 1 To objDocShapes.Count
    On Error Resume Next
    'this produces an error if the shape is not a group:
    lngGroupCt = objDocShapes(n).GroupItems.Count
    If lngGroupCt = 0 Then
        'No group, do replace for one textbox
        With objDocShapes(n).TextFrame.TextRange.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "FindText"
            .Replacement.Text = "ReplaceText"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute Replace:=wdReplaceAll
        End With
    Else
        'There was a group
        objDocShapes(n).Ungroup
        'cycle through all the ungrouped shapes
        For c = n To n + (lngGroupCt - 1)
            With objDocShapes©.TextFrame.TextRange.Find
                .Text = "FindText"
                .Replacement.Text = "ReplaceText"
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .Execute Replace:=wdReplaceAll
            End With
        Next c
        'Regroup the specific shapes - takes advantage
        ' of the quirk that you need select only the first
        ' shape and regroup
        objDocShapes(n).Select
        Selection.ShapeRange.Regroup
    End If
Next n
End Sub

Reply | Quote

Ed contacted me to point out that the previous code as posted, needed further tweaking:
In a multipage document, the textboxes were getting regrouped all at one location, probably having to do with where the insertion point happened to be when the macro started.

To work around that, I’ve added one line, which ensures that the selection is at the specific grouped textboxes object, before it is ungrouped. This appears to ensure it stays in the right place when regrouped.

Sub UngroupRegroupAllTweaked()
'Gary Frieder  January 2001
'Purpose:   Enable a find/replace on text in all textboxes in a document.
'           This requires temporarily ungrouping any grouped textboxes,
'           doing the find/replace, and then regrouping them.
'           Tweaked to work properly on multipage documents
Dim objDocShapes As Shapes
Dim lngGroupCt As Long
Dim n As Long
Dim c As Long
Set objDocShapes = ActiveDocument.Shapes
For n = 1 To objDocShapes.Count
    On Error Resume Next
    'this produces an error if the shape is not a group:
    lngGroupCt = objDocShapes(n).GroupItems.Count
    If lngGroupCt = 0 Then
        'No group, do replace for one textbox
        With objDocShapes(n).TextFrame.TextRange.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "FindText"
            .Replacement.Text = "ReplaceText"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute Replace:=wdReplaceAll
        End With
    Else
        'There was a group
        objDocShapes(n).Select
        objDocShapes(n).Ungroup
        'cycle through all the ungrouped shapes
        For c = n To n + (lngGroupCt - 1)
            With objDocShapes©.TextFrame.TextRange.Find
                .Text = "FindText"
                .Replacement.Text = "ReplaceText"
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .Execute Replace:=wdReplaceAll
            End With
        Next c
        'Regroup the specific shapes - takes advantage
        ' of the quirk that you need select only the first
        ' shape and regroup
        objDocShapes(n).Select
        Selection.ShapeRange.Regroup
    End If
Next n
End Sub

Reply | Quote