Question

我已经看到一些有关从excel创建单词表的问题，但它们并没有我想要的东西。我有一张Excel表格，其中包含有关设备的详细信息（公司编号，序列号，制造商，描述和型号）。该文件当前有17114行设备数据。我有一个Word文档，其中包含四列（数量，公司编号，零件编号，描述）。

现在在excel上，我有一个按钮可以打开doc一词，另一个按钮可以打开一个用户表单。用户表单具有一个组合框和一个文本bot。组合框选择要在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)

到单词的第二列；

    Cells (myResult, 2)

到单词的第三列；和

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

改为单词的第4列。我也在寻找单词来检查第一个空白行在哪里（在标题之后）并将其插入那里。并且如果在页脚（也是表的一部分）之前没有空白行，则添加一行。

我可以放入数据的默认行数是16。表头有13行（表头是表的一部分）。总共19行将创建第二页，但第二页上没有用于数据的任何单元格（仅页眉和页脚）。直到排成28行，数据单元才开始在第2页上弹出。

我的问题是如何用单词引用表格中的特定单元格？我可以像在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

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

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

1 个答案: