VBA多个Word表到Excel - 文档中没有表

时间:2016-09-22 14:06:23

标签: excel vba excel-vba ms-word

几个月前我从大型Word文档中导出了所有表格,然后我的计算机丢失了我用过的VBA ...注意++决定消失并带走我的所有文件。

所以,我已经查找了几个不同的选项,将所有表格从Word文件拉到Excel。

我尝试的每个人都说Word文件中没有表格。我尝试了多个文件,都是一样的。

我的环境中唯一的其他变化是我升级到Windows 10。

我绞尽脑汁,无法弄清楚为什么没有看到桌子?

我可以将表格复制到另一个单词文件中:

Sub CopyTables()
Dim Source As Document
Dim Target As Document
Dim tbl As Table
Dim tr As Range

Set Source = ActiveDocument
Set Target = Documents.Add

For Each tbl In Source.Tables
    Set tr = Target.Range
    tr.Collapse wdCollapseEnd
    tr.FormattedText = tbl.Range.FormattedText
    tr.Collapse wdCollapseEnd
    tr.Text = vbCrLf
Next
End Sub

我可以在word文件中找到表号:

Sub FindTableNumber()
Dim J As Integer
Dim iTableNum As Integer
Dim oTbl As Table

Selection.Bookmarks.Add ("TempBM")
For J = 1 To ActiveDocument.Tables.Count
    Set oTbl = ActiveDocument.Tables(J)
    oTbl.Select
    If Selection.Bookmarks.Exists("TempBM") Then
        iTableNum = J
        Exit For
    End If
Next J
ActiveDocument.Bookmarks("TempBM").Select
ActiveDocument.Bookmarks("TempBM").Delete
MsgBox "The current table is table " & iTableNum
End Sub

这是我尝试过的VBA示例,并收到了文档中的无表:

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

On Error Resume Next

ActiveSheet.Range("A:AZ").ClearContents

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

    resultRow = 4

    For tableStart = 1 To tableTot
        With .tables(tableStart)
            'copy cell contents from Word table cells to Excel cells
            For iRow = 1 To .Rows.Count
                For iCol = 1 To .Columns.Count
                    Cells(resultRow, iCol) = WorksheetFunction.Clean(.cell    (iRow, iCol).Range.Text)
                Next iCol
                resultRow = resultRow + 1
            Next iRow
        End With
        resultRow = resultRow + 1
    Next tableStart
End With

End Sub

0 个答案:

没有答案