将特定的 MS 单词表提取到 Excel 中

Question

我有一份导入到 word 中的报告。它有字段（对于每个报告保持相同），每个字段在左侧各自的表格中对应于右侧的值（每个报告更改）。目标是将这些对应的值放在单行中以进行 excel。我遇到的问题是识别字段表，然后将光标向右移动并选择相应表中的值。现在我正在操作另一个脚本，它允许用户选择一个单元格，运行脚本，选择文件，找到字段表，选择右侧的表，将值复制到 Excel 中。由于软件如何导入 word，所有表格都是 1x1 单元格。

Sub GrabUsage()
Dim FName As String, FD As FileDialog
Dim WApp As Object, WDoc As Object, WDR As Object
Dim ExR As Range
Dim TableNo As Long

Set ExR = Selection ' current location in Excel Sheet

'let's select the WORD doc
Set FD = Application.FileDialog(msoFileDialogOpen)
FD.Show
If FD.SelectedItems.Count <> 0 Then
    FName = FD.SelectedItems(1)
Else
    Exit Sub
End If

 ' open Word application and load doc
Set WApp = CreateObject("Word.Application")
' WApp.Visible = True
Set WDoc = WApp.Documents.Open(FName)
TableNo = WDoc.tables.Count

' Find field table on left side
WApp.Selection.Find.Execute FindText:="Unique Furniture Produced"

' move cursor to corresponding value table on right side
WApp.Selection.Move Unit:=TableNo, Count:=1

' I need this part to select the tables value
'WApp.Selection.MoveRight Unit:=2, Count:=1, Extend:=1

' grab and put into excel
Set WDR = WApp.Selection
ExR(1, 1) = WDR ' place at Excel cursor

WDoc.Close
WApp.Quit

End Sub

在选定的 Excel 单元格中打印一个方形符号，而对于我正在使用的示例报告，它应该打印 2。我们希望保留生产的运行日志，并且能够使用 VBA 将导入的 word 报告中的数据提取到 excel 中，这将大有帮助。

Answer 1

使用不同的方法解决：

Sub ReportImport()

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 resultRow As Long
Dim lastrow As Integer
Dim tableStart As Integer
Dim tableTot As Integer

On Error Resume Next



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

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

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    tableNo = wdDoc.tables.Count
    tableTot = 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 the table to start from", "Import Word Table", "1")
    End If

    lastrow = Cells(Rows.Count, 2).End(xlUp).Row
    resultRow = lastrow - 2

    tableStart = 1
    With .tables(tableStart)
        Cells(resultRow, 3) = WorksheetFunction.Clean(.cell(3, 3).Range.Text)  'sheets
        Cells(resultRow, 4) = WorksheetFunction.Clean(.cell(11, 3).Range.Text) 'gross sa
        Cells(resultRow, 5) = WorksheetFunction.Clean(.cell(6, 3).Range.Text)  'gross $
        Cells(resultRow, 6) = WorksheetFunction.Clean(.cell(4, 4).Range.Text)  'yield different call from column then rest
        Cells(resultRow, 7) = WorksheetFunction.Clean(.cell(12, 3).Range.Text) 'net sa
        Cells(resultRow, 8) = WorksheetFunction.Clean(.cell(7, 3).Range.Text)  'net $
        Cells(resultRow, 9) = WorksheetFunction.Clean(.cell(8, 3).Range.Text)  'scrap $
        Cells(resultRow, 10) = WorksheetFunction.Clean(.cell(10, 3).Range.Text) 'cut in.

    End With

End With

End Sub