Question

我有一个导入到word中的报告。它具有字段（每个报告保持相同），每个字段在左侧各自的表中，对应于右侧的值（每个报告更改）。目标是将这些相应的值放在Excel中的一行中。我遇到的问题是识别字段表，而不是将光标向右移动并选择相应表中的值。现在我正在操作另一个脚本，允许用户选择一个单元格，运行脚本，选择文件，找到字段表，选择右边的表，将值复制到excel。由于软件如何导入单词，所有表格都是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将导入的单词报告中的数据提取到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

将特定的MS字表提取到Excel中

1 个答案: