时间戳

首页 > 解决方案 > Microsoft word：将文本从多个文本框中复制到选择表中

vba - Microsoft word：将文本从多个文本框中复制到选择表中

问题描述

我正在尝试仅从 word 文档中的多个文本框中复制粗体文本，并将其粘贴到不同行表中的选定列中。例如，文本框 1 中的粗体文本应进入表格的第 2 行和第 2 列。同样，文本框 2 中的文本应该进入表格的第 3 行和第 2 列。这应该一直持续到所有文本框都被读取和复制。

但是我正在尝试的代码是从所有文本框中复制所有文本并将其粘贴到不同的行中。我无法弄清楚如何从文本框中仅提取粗体文本并将文本从消息框 1 粘贴到第 1 行，将消息框 2 粘贴到第 2 行，依此类推。

我是 VBA 新手，因此我们将不胜感激任何帮助。

我自定义的代码如下：

Sub Copytextfromtextbox()
    Dim nNumber As Integer
    Dim strText As String
    Dim i As Long
    With ActiveDocument
For nNumber = 1 To .Shapes.Count Step 1
If .Shapes(nNumber).Type = msoTextBox Then
       strText = strText & .Shapes(nNumber).TextFrame.TextRange.Text & vbCr
  For i = 2 To nNumber Step 1
         With ActiveDocument.Tables(5).Cell(Row:=i, Column:=2).Range
     .Delete
     .InsertAfter Text:=strText
 End With
 Next
    Else
MsgBox ("There is no textbox.")
    End If
  Next
End With
        End Sub

标签： vbams-word

解决方案

您究竟需要什么尚不清楚，举个例子说明文本框的内容可能是什么以及应该将哪些部分转移到表格单元格中会有所帮助。以下将做我理解的要求：

循环文档中的所有形状。如果 Shape 是 TextBox，则定位粗体文本并将其转移到特定表格的第二列，在文档中文本框位置的行索引 +1（第 2 行第一个，第 3 行第二个，等等）。

请注意，我为代码使用的单词“事物”添加了对象变量，例如 a Document、 a Table、 aRange和 a Shape。这更有效，更容易遵循并且不太容易使用错误的东西。

使用 循环形状更清晰For Each。

为了拾取粗体文本，Word 的Find功能是高效的。这是在TextRange文本框上执行的。（有关使用的更多信息，Find请参阅 Word VBA 语言参考以及在 Internet 上的此处和其他地方使用它的许多贡献。作为用户在 Word 应用程序中使用 Word 的“高级查找”并记录宏也是有指导意义。）

每次找到文本框时，i都会递增以标识表格行。

Sub Copytextfromtextbox()
    Dim nNumber As Integer
    Dim strText As String
    Dim i As Long
    Dim doc As Document
    Dim tbl As Table
    Dim rng As Range
    Dim shp As Shape

    Set doc = ActiveDocument
    Set tbl = doc.Tables(5)
    i = 0
    With doc
        For Each shp In .Shapes
            If shp.Type = msoTextBox Then
                Set rng = shp.TextFrame.TextRange
                With rng.Find
                    .Font.Bold = True
                    .Wrap = wdFindStop
                    .Execute
                    strText = rng.Text
                End With
                i = i + 1
                With tbl.Cell(Row:=i + 1, Column:=2).Range
                    .Delete
                    .InsertAfter Text:=strText
                End With
            Else
                MsgBox ("There is no textbox.")
            End If
        Next
    End With
End Sub

推荐阅读