MS Word Textbox Macro

Question

I am trying to make a macro that reads a document that is full of text boxes through out the whole document and removes the text box but puts the text box's text in the sentence where the text box was.

I found this code on some site which kinda works but not exactly. It reads the whole document and removes only the first text box it finds in each row and puts the text in the beginning of the row.

' removes all text boxes and puts the text next to the box

    Dim shp As Shape

    Dim oRngAnchor As Range

    Dim sString As String

    For Each shp In ActiveDocument.Shapes

        If shp.Type = msoTextBox Then

            ' copy text to string, without last paragraph mark

            sString = Left(shp.TextFrame.TextRange.Text, _

              shp.TextFrame.TextRange.Characters.Count - 1)

            If Len(sString) > 0 Then

                ' set the range to insert the text

                Set oRngAnchor = shp.Anchor.Paragraphs(1).Range

                ' insert the textbox text before the range object

                oRngAnchor.InsertBefore _

                  sString

            End If

            shp.Delete

        End If

    Next shp

Any help would be greatly appreciated, thank you.

Answer 1

I think this will do the trick. I try to stay away from using selections, but sometimes with text boxes that's the simplest way:

Sub TextboxRemoval()

  Dim shp As Shape, shpRange As ShapeRange

  Dim sString As String

  Dim shpArray() As Variant

  x = 1

  For Each shp In ActiveDocument.Shapes

    If shp.Type = msoTextBox Then

      sString = Left(shp.TextFrame.TextRange.Text, shp.TextFrame.TextRange.Characters.Count - 1)

      If Len(sString) > 0 Then

        shp.Select

        Selection.Collapse wdCollapseStart

        Selection.InsertBefore sString

        ReDim Preserve shpArray(1 To x)

        shpArray(x) = shp.Name

        x = x + 1

      End If

    End If

  Next shp

  Set shpRange = ActiveDocument.Shapes.Range(shpArray)

  shpRange.Delete

End Sub

Answer 2

I have created a form in MS infopath that will allow the engineers in my group to create Protocols/Completion Reports and other types of reports. Once the form is filled out in infopath I have coded a button that will output a .mht file to the desktop from the form.  Next, the engineer will open the .mht file in MS word, run a macro to clean it up (this macro includes: removing text boxes, deleting section and column breaks, saving as a .docx file, changing to print view, and adjusting line spacing and font). After this macro the engineer will have a finished product to submit for approvals.

I basically need a way to bring the infopath form over to word and clean it up to produce a finished product.

Answer 3

Of course the text appears at the beginning of the line. Text boxes are the chief way to make text float, but you've eliminated the text box, so the text is in-line. The macro places the text in the paragraph where the text box was anchored, not where it was located on the page. Text box anchor locations are completely independent of the location of the actual text box.

To make the text appear close to where the text box was, you would have to get the vertical position of every text box (shp.Top), then figure which paragraph mark is closest to that position (Selection.Information(wdVerticalPositionRelativeToPage)) and insert the text there. But it's still going to be at the left margin.

Implications: Of course, this also means that if you have two text boxes at close to the same vertical height, their content is going to end up in the same paragraph mark. So you're also going to have to write a subroutine that checks the paragraph mark where you intend to place text to find if there is text already there. If there is, you need to insert the next text after the existing text instead of replacing it.

If you want to make the text appear in exactly the same position in-line as when it was in a text box, you've set yourself a mind-numbing programming job. I'm curious why it is you want to do this. If you explain, perhaps we can think of a simpler way to get the job done.

Answer 4

Thank you very much for your code and that solved one of the problems but it still is moving the text to the beginning of the line and not where the text box used to be like I need it to do.  If you could give me any assistance with this as well it'd be greatly appreciated.

Answer 5

The problem with your code is that you count the number of shapes, but then you delete one at the end of each loop, so the counter loses track and only deletes every second text box. The code below tracks each text box and adds it to a ShapeRange that is deleted after everything else is done:

Sub TextboxRemoval()

  Dim shp As Shape, shpRange As ShapeRange

  Dim oRngAnchor As Range

  Dim sString As String

  Dim shpArray() As Variant

  x = 1

  For Each shp In ActiveDocument.Shapes

    If shp.Type = msoTextBox Then

      sString = Left(shp.TextFrame.TextRange.Text, shp.TextFrame.TextRange.Characters.Count - 1)

      If Len(sString) > 0 Then

        ReDim Preserve shpArray(1 To x)

        shpArray(x) = shp.Name

        ' set the range to insert the text

        Set oRngAnchor = shp.Anchor.Paragraphs(1).Range

        ' insert the textbox text before the range object

        oRngAnchor.InsertBefore sString

        x = x + 1

      End If

    End If

  Next shp

  Set shpRange = ActiveDocument.Shapes.Range(shpArray)

  shpRange.Delete

End Sub