Word macro to ungroup text boxes

Question

I work in a disability services office, and one thing we do fairly frequently is enlarge Word documents which were converted from PDF. To streamline the process, I've been working on "writing" a macro (mostly actually copying and pasting bits from elsewhere or from the macro recorder) to do things like remove extra paragraph breaks or "normalize" the font style/size/spacing/etc.

Often, when we convert a PDF file to a Word file we end up with some of the text in textboxes. I would like to be able to remove text from all text-boxes and replace them with the plain text. I don't care about keeping any formatting for the text at all, or keeping decorative lines and what not. I found some code in my searching that works for text boxes which aren't grouped, but I have a document where the textboxes are grouped.

I found a macro which should ungroup shapes, including textboxes. But when I run the macro, the ungroup line throws an error message; "Run-time error '-2147024891 (80070005)': Group is locked and cannot be ungrouped" I can manually select and ungroup the textboxes UNLESS I've manually set them to be in-line in the document, at which point the "ungroup" selection is grayed-out in the tab. If I copy JUST the textbox to a new document and run the ungroup macro, it works as intended, but only after I manually set the group to something other than in-line. If I leave it as in-line, the macro throws the same error message.

The code in question:

Sub Ungroup
    Dim xNmbr As Integer
    Dim strText As String
    With ActiveDocument
    For xNmbr = .Shapes.Count To 1 Step -1
    .Shapes(xNmbr).Select
    .Shapes(xNmbr).ConvertToInlineShape
    .Shapes(xNmbr).Ungroup
    Next
    End With
End Sub

Anyone know what's going on here? I know there's one other question on here which asks about the same error message but they're working with shapes that aren't text so their solution doesn't work for me.

Here's a sample file that's the same as the one I was trying to edit (I just changed the text; the structure is the same).

https://www.dropbox.com/s/z6ovashu3qv43i9/Fake%20Book.docx?dl=0

Thanks in advance!

ETA -- here's some code that works on my sample document perfectly, but in other documents I've tried it on deletes the text boxes instead of ungrouping them.

Sub Ungroup()
    Dim xNmbr As Integer
    With ActiveDocument
    For xNmbr = .Shapes.Count To 1 Step -1
        .Shapes(xNmbr).Select
        Set thisshape = .Shapes(xNmbr)
    With thisshape.WrapFormat
        .Type = wdWrapSquare
    End With
Next
End With

Dim mydocument As Document
    Set mydocument = ActiveDocument
    Dim shp As Shape
    For Each shp In mydocument.Shapes
        If shp.Type = msoGroup Then shp.Ungroup
    Next shp
End Sub

Word has two collections for graphics: InlineShapes and Shapes. Only something that is not in-line can be grouped/ungrouped. You need to apply a text-wrap formatting in order to use this command. — Cindy Meister
Thank you! That helped. Now I'm having a bizarre issue. I've got the ungroup working in one of my test documents, but in other documents it deletes all my textboxes instead of ungrouping them. I have NO idea why. How do I share my (partly) working code in these comments? Edit: I updated my original post with the partly-working code. — Andi
You shouldn't add your solution to the original question. Instead, if the information will help others, put it in the ANSWER box. On Stack Overflow you're allowed (even encouraged) to answer your own questions :-) You can also mark them as "the" answer (or whatever contribution fulfills that). Once you have enough reputation points you can upvote any contribution on the site that you find helpful (questions and answers). You can go back to the edit part of your question and ROLLBACK the change you made. — Cindy Meister

Andi Andi · Accepted Answer · 2018-07-03T20:51:01

Final update: I got it working! I don't know what was causing the problem, but just paring down the code some got it working correctly.

Sub Ungroup()
Dim xNmbr As Integer
With ActiveDocument
    For xNmbr = .Shapes.Count To 1 Step -1
    .Shapes(xNmbr).Select
        Set thisshape = .Shapes(xNmbr)
        With thisshape.WrapFormat
       .Type = wdWrapSquare
    If thisshape.Type = msoGroup Then thisshape.Ungroup
    End With
    Next
End With
End Sub

Word macro to ungroup text boxes

1 Answers