将特定word文档中的单词导入特定的Excel文档

时间:2017-07-21 17:12:37

标签: excel vba excel-vba

尝试将特定Microsoft Word文档中的特定表导入某个Excel工作表。

该表位于特定的Word文档中,然后我尝试将其粘贴到正确的Excel工作表的Excel单元格范围E8:N21中。

我已经在下面修改了这段代码,但却不断遇到问题:

Option Explicit

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel

wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdHuddle) 'open Word file

With wdDoc
TableNo = wdDoc.tables.Count
If TableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf TableNo > 1 Then
TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
"Enter table number of table to import", "Import Word Table", "1")
End If
With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
Next iCol
Next iRow
End With
End With

Set wdDoc = Nothing

End Sub

现在,它还要求导入正确的word文档,但这并不是必需的,因为它总是从特定位置从同一个word文档中拉出表格

1 个答案:

答案 0 :(得分:0)

下面是执行您请求的代码,以及显示正在运行的动画gif。您需要做的就是将fName替换为Word文档的完整路径,并更改行&列开始位置为iCol = 5,for循环中的iRow = 9(E9)。

Option Explicit

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim fName As String

'============= PLACE YOUR WORD DOCUMENT PATH HERE =================
fName = "\\vmware-host\Shared Folders\Desktop\Test.docx"

Set wdDoc = GetObject(fName) 'open Word file

With wdDoc
TableNo = wdDoc.tables.Count
If TableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf TableNo > 1 Then
TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
"Enter table number of table to import", "Import Word Table", "1")
End If
With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
Next iCol
Next iRow
End With
End With

Set wdDoc = Nothing

End Sub

enter image description here