通过 VBA 宏将文本框添加到 Word 文档表

Question

情况如下：

我正在使用 SQL Server Reporting Service 生成导出到 Word 2010 的报告。报告本身以一组嵌套表的形式出现。我需要能够访问这些内部表格之一并将文本框添加到表格中的特定单元格。

我需要以一种可以循环执行的方式执行此操作，以遍历特定表中的所有行。该表可以有 n 行，并且需要在每一行中修改此单元格。因此，问题是双重的。我需要能够索引到正确的表并获得指向特定单元格的指针，然后我需要修改单元格的内容以在其中包含单个文本框控件。我的理解是您使用shapes集合来添加文本框本身，但我不知道如何获取对特定表格的特定单元格的引用，并找到与之关联的shapes集合。

对此的任何帮助将不胜感激。

我正在使用此代码尝试迭代文档中的表格，但没有“HasTable”属性，只有一个用于“HasChart”和“HasSmartArt”

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

此代码将添加一个文本框，但我不知道如何将它放在我正在使用的表的右列中，这也没有给我提供一种方法来索引所有行中的行表格添加文本框：

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

我尝试了以下方法，但似乎没有帮助：

为 ActiveDocument.Tables 中的每个 tbl 将 tbl 设置为 Word.Table

    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

这将添加文本框，但不会将其放在正确的单元格中。

XAML 中的可视化树是一种分层数据结构，其中包含 XAML 页面的所有可视化元素。您可以递归地遍历它以查找特定节点，然后在找到后修改给定节点的内容。这就是我在这里想要做的，但我没有看到那种结构

Answer 1

从此处找到的代码进行了大量修改：

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

试试这个，可能需要针对您的特定用途进行一些微调，但这会添加一个相对于表格中任何单元格的文本框，并将其锚点设置为表格。

未经测试的修订版应查找多个占位符（在 strText 变量中指定占位符文本）并在每个表中添加带有相应单元格的文本框。

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