Search code examples
vbams-wordtextboxcell

Convert ActiveX text box to table cell


Is there an example of a macro that converts each ActiveX text box in a Word document to a table cell (1 x 1). Text formatting can be ignored.

I have this example for Excel, but do not know which Word objects and methods to use.

I want to use ActiveX text boxes to restrict the size of the text content, which is not directly possible in Word table cells. Also I do not want to insert text form fields into the Word table cells instead of using text boxes, because of subsequent processing of the tables.


Solution

  • Without an example of conversion, which would be more elegant, I have written a workaround that copies the text box content to a 1x1 table. Note that ALL inline shapes are subsequently deleted, not just text boxes.

    Sub Copy_textbox_to_new_table()
    'Loops through ActiveX text boxes and copies content
    'Adds table at bookmark named "bm1", "bm2", ...
    'Pastes text from text box into table
    'NB all text boxes to be copied must be renamed "TB1", "TB2", ...
    
    Dim txtbText(1 To 5)
    Dim txtb As InlineShape
    Dim i As Long 'counter
    Dim tbl(1 To 5)
    Dim tblPlace As Range
    
    On Error Resume Next
    
    For i = 1 To 5 '<-text box names must be modified to TB1 ... TBn and value of n is To value here
        For Each txtb In ActiveDocument.InlineShapes
            If Not txtb.OLEFormat Is Nothing And _
                txtb.OLEFormat.ClassType = "Forms.TextBox.1" And _
                txtb.OLEFormat.Object.Name = "TB" & i Then
            txtbText(i) = txtb.OLEFormat.Object.Text
            
            Set tblPlace = ActiveDocument.Range.Bookmarks("bm" & i).Range
            
            Set tbl(i) = ActiveDocument.Tables.Add(Range:=tblPlace, NumRows:=1, NumColumns:=1)
            tbl(i).Cell(1, 1).Select
            Selection.Text = txtbText(i)
                   
            End If
            
        Next
    
    Next
    
    'Delete all inline shapes
    For i = ActiveDocument.InlineShapes.Count To 1 Step -1
    ActiveDocument.InlineShapes(i).Select
    Selection.Delete
    Next i
    
    End Sub