从Excel到Word表格中的特定单元格

Question

我看到了一些关于从Excel创建Word表格的问题的答案，但它们并不完全符合我的需求。我有一个Excel表格，其中包含设备的详细信息（公司编号、序列号、制造商、描述和型号号码）。该文件目前有17114行设备数据。我有一个具有四列（数量、公司编号、零件编号、描述）的Word文档。

现在，在Excel上我有一个按钮来打开Word文档，另一个按钮则会弹出用户窗体。用户窗体有一个组合框和一个文本框。组合框选择要在Excel中搜索哪个列。文本框是人们正在寻找的内容。下面是此代码的代码：

Dim myLastRow As Long
Dim myResult As Long
Dim myTableRange As Range

myLastRow = Cells(Rows.Count, 1).End(xlUp).Row

If ComboBox1.Value = "Serial" Then
    Set myTableRange = Range("B1:B" & myLastRow)
    myResult = Application.Match(TextBox1.Value, myTableRange, 0)            'Returns row number only
    Range("B" & myVLookupResult).Activate
ElseIf ComboBox1.Value = "MII" Then
    Set myTableRange = Range("A1:A" & myLastRow)
    myResult = Application.Match(TextBox1.Value, myTableRange, 0)            'Returns row number only
    Range("A" & myResult).Activate
Else
    MsgBox ("No Range Selected")
End If

“MII”指的是公司编号。该代码位于命令按钮上。我想从这里开始，宏可以将数据从myResult复制到Word中。要复制的单元格为：

   Cells(myResult, 1) 

将内容移动到Word文档的第二列；

    Cells (myResult, 2)

将文本移到Word中的第三列；以及

    Cells(myResult, 3) & ", " & Cells(myResult, 4) & ", Model #" & Cells(myResult, 5)

寻找word中第四列的位置。我还希望word检查第一个空白行（在标题之后），并将它们插入到那里。如果页脚之前没有空白行（也是表格的一部分）就添加一行。

默认情况下，我可以将数据放入16行中。其中13行为标题（标题是表格的一部分）。总共19行会创建第二页，但第二页上没有任何单元格用于数据（只有标题和页脚）。只有当28行被制作出来时，第二页才开始出现用于数据的单元格。

我的问题是如何在word中引用表格中的特定单元格？我能否像在excel中一样使用相同的代码查找标题后的第一个空白单元格吗？对于添加到表格中的行以及计算可用行数以确保我输入正确的页码，代码是否相同？

目前，我在宏中仅调用了文档。

    Dim objWord, objDoc As Object
    Set objWord = GetObject(, "Word.Application")
    objWord.Visible = True

我知道我可以使用类似以下的方法，但这并没有指定数据放在哪里。

    Sheets(1).Range(FirstCell, LastCell).Copy
    objWord.Selection.Paste
    objWord.Selection.TypeParagraph

- b.sauer

---

编辑：我找到了获取表格行中特定单元格的方法： objWord.ActiveDocument.Tables(1).Cell(Row:=13, Column:=1).Range.Text = "1" objWord.ActiveDocument.Tables(1).Cell(Row:=13, Column:=2).Range.Text = Cells(myResult, 1).Value objWord.ActiveDocument.Tables(1).Cell(Row:=13, Column:=3).Range.Text = Cells(myResult, 2).Value objWord.ActiveDocument.Tables(1).Cell(Row:=13, Column:=4).Range.Text = Cells(myResult, 3).Value & ", " & Cells(myResult, 4).Value & ", 型号 #" & Cells(myResult, 5).Value - b.sauer

不，我仍需要帮助。我已经弄清楚了如何将Excel中的单元格转移到Word（请参见上面的评论），以及如何在表格中换行。但如果Word表格中的所有行都已满，我还没有找到添加新行的方法。 - b.sauer

Answer 1

我仍然没有弄清楚如何自动添加行。我一直得到运行时错误'5991'：无法访问此集合中的单个行，因为表格具有垂直合并的单元格。（编辑：我发现我没有单击Microsoft Word对象库引用。在这样做后，对于这个问题的其他答案有效。）

由于我的所作所为仍然是一个不错的时间节省器，并且可能会帮助其他试图做同样事情的人们，我将发布我目前所拥有的东西。注意：仍然有一些未使用的代码，尝试一些东西以查看它是否起作用。

 Dim myLastRow As Long
 Dim myResult As Long
 Dim myTableRange As Range

 myLastRow = Cells(Rows.Count, 1).End(xlUp).Row

If ComboBox1.Value = "Serial" Then
    Set myTableRange = Range("B1:B" & myLastRow)
    myResult = Application.Match(TextBox1.Value, myTableRange, 0)            'Returns row number only
ElseIf ComboBox1.Value = "MII" Then
    Set myTableRange = Range("A1:A" & myLastRow)
    myResult = Application.Match(TextBox1.Value, myTableRange, 0)            'Returns row number only
Else
    MsgBox ("No Range Selected")
End If

 Dim objWord, objDoc As Object
 Set objWord = GetObject(, "Word.Application")
 objWord.Visible = True

 Dim tableRow As Long
 Dim rowCount As Long
 Dim lastTableCell As Long
 Dim i As Long
 Dim cellEmpty As Boolean

 'lastTableCell = 28                     'Defualt input range is from cell 13 to 28
 lastTableCell = 100
 cellEmpty = True

 findEmptyCell:
 For i = 13 To lastTableCell
    If objWord.ActiveDocument.Tables(1).Cell(i, Column:=1).Range.Text = Chr(13) & Chr(7) Then
        tableRow = i
        cellEmpty = True
        GoTo rowFound
    End If

 allCellsFilled:
    If cellEmpty = False Then
        objWord.ActiveDocument.Tables.Item(1).Rows(i - 1).Select
        Selection.InsertRowsBelow (i - 1)
        cellEmpty = True
        GoTo findEmptyCell
    End If
Next i

 rowFound:
 On Error GoTo errorHappened
     objWord.ActiveDocument.Tables(1).Cell(Row:=tableRow, Column:=1).Range.Text = "1"
     objWord.ActiveDocument.Tables(1).Cell(Row:=tableRow, Column:=2).Range.Text = Cells(myResult, 1).Value
     objWord.ActiveDocument.Tables(1).Cell(Row:=tableRow, Column:=3).Range.Text = Cells(myResult, 2).Value
     objWord.ActiveDocument.Tables(1).Cell(Row:=tableRow, Column:=4).Range.Text = Cells(myResult, 3).Value & ", " & Cells(myResult, 4).Value & ", Model # " & Cells(myResult, 5).Value
GoTo endTheSub

 errorHappened:
cellEmpty = False
GoTo allCellsFilled

 endTheSub:

 End Sub

- b.sauer