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

Question

情况如下：

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

我需要以一种可以在循环中进行的方式来遍历特定表中的所有行。 rows, and this cell needs to be modified in each of them. 该表可以有行，并且需要在每行中修改此单元格。 因此，问题是双重的。 我需要能够索引正确的表并获得指向特定单元格的指针，然后我需要修改单元格的内容以在其中具有单个文本框控件。 据我了解，您使用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的Dib 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