Add Text Box to Word Document Table Through a VBA Macro

Question

The situation is the following:

I am using SQL Server Reporting Service to produce a report that is exported to Word 2010. The report itself comes out as a set of nested tables. I need to be able to reach in to one of these inner tables and add a Text Box to a specific cell in the table.

I need to do this in a way that I can do it I a loop, to loop through all of the rows in the specific table. The table can have n rows, and this cell needs to be modified in each of them. The problem, therefore is twofold. I need to be able to index into the correct table and get a pointer to the specific cell, and then I need to modify the contents of the cell to have a single text box control in it. It is my understanding that you use the shapes collection to add the text box itself, but I don't know how to get a reference to the specific cell of the specific table, and find the shapes collection that is associated with it.

Any help on this would be greatly appreciated.

I am using this code to try and iterate the tables in the document, but there is no "HasTable" property, just one for "HasChart" and "HasSmartArt"

Dim Shp As Shape
For Each Shp In ThisDocument.InlineShapes 
    If Shp.HasTable Then 
        MsgBox "Found Table" 
    End If 
Next Shp

This code will add a text box but I don't see how to get this to be in the right column of the table I am working with, nor does this give me a way t index through all of the rows in the table adding the text box:

ActiveDocument.Shapes.AddTextbox _
    Orientation:=msoTextOrientationHorizontal, _
    Left:=lLeft, 
    Top:=6, _
    Width:=72, _
    Height:=12

I have tried the following and it doesn't seem to help:

Dim tbl As Word.Table For Each tbl In ActiveDocument.Tables

    tbl.Columns.Select


    If tbl.Tables.Count > 0 Then
      tbl.Tables(1).Select

          ActiveDocument.Shapes.AddTextbox Orientation:=msoTextOrientationHorizontal, _
          Left:=tbl.Tables(1).Columns.Borders.DistanceFromLeft, _
          Top:=tbl.Tables(1).Columns.Borders.DistanceFromTop, _
          Width:=72, _
          Height:=12

    End If
Next tbl

This will add the text box, but it doesn't put it in the right cell.

The Visual Tree in XAML is a hierarchical data structure that contains all the visual elements of a XAML page. You can walk it recursively looking for specific nodes, and then modify the content of the given node once you find that. That is what I am trying to do here, but I am not seeing that kind of structure

Answer 1

heavily modified from code found here:

http://www.msofficeforums.com/word-vba/11055-word-vba-add-textboxs-table-cells.html

Try this, may require some slight tweaking for your specific use but this will add a textbox relative to any cell in a table, and set its anchor to the table.

Untested revision should look for multiple placeholders (specify placeholder text in strText variable) and add textbox with the appropriate cell for each, in each table.

Option Explicit
Sub AddTextBoxToTableCell()
Dim tbl As Table
Dim tblRow As Row
Dim t As Integer
Dim bkmark As String
Dim tblCell As Cell
Dim clTop As Long
Dim clLeft As Long
Dim tbWidth As Single
Dim tbHeight As Single
Dim strText as String


'## Specify dimensions of textbox:
    tbWidth = 72
    tbHeight = 10

'## Specify the placeholder text
    strText = "[placeholder for textbox]"

'## Iterate the tables
For Each tbl In ActiveDocument.Tables

    t = t + 1


    '## Define the cell we want to use (modify as needed)
    For r = 1 to tbl.Rows.Count
        For c = 1 to tbl.Columns.Count
            If tbl.Cell(r,c).Range.Text = strText then
               '## Construct a string to use as a Bookmark
                bkmark = "table_" & t & "_Row" & r & "_Col" & c
                Set tblCell = tbl.Cell(r, c)


                '## Get the position of the cell
                clLeft = GetCellAbsoluteLeft(tblCell)
                clTop = tblCell.Range.Information(wdVerticalPositionRelativeToPage)

                '## Add a bookmark if it does not already exist
                If ActiveDocument.Bookmarks.Exists(bkmark) Then
                    ActiveDocument.Bookmarks(bkmark).Delete
                End If

                '## Add/Update the bookmark location
                ActiveDocument.Bookmarks.Add "table_" & t, tblCell.Range

                '## Add a textbox to your table:
                ActiveDocument.Shapes.AddTextbox msoTextOrientationHorizontal, _
                    clLeft, clTop, tbWidth, tbHeight, _
                    Anchor:=ActiveDocument.Bookmarks(bkmark).Range
            End If
        Next
    Next


Next


End Sub

Function GetCellAbsoluteLeft(cl As Cell) As Long
'## Custom function to return the absolute left position in points, of a table cell
Dim col As Integer
Dim c As Integer
Dim ret As Long

ret = cl.Range.Information(wdHorizontalPositionRelativeToPage)

col = cl.Range.Information(wdStartOfRangeColumnNumber)

c = 1

'## Add up the column widths with the position wdHorizontalPositionRelativeToPage
Do
    ret = ret + cl.Row.Cells(c).Width
    c = c + 1
Loop While Not c >= col

'## Return the value:
GetCellAbsoluteLeft = ret

End Function