将WORD中的表格转换到EXCEL中

将WORD中的表格转换到EXCEL中 

以下代码在WORD中使用

Option Explicit

Sub word2Excel()
    Dim iPath As String, iName As String, i As Long, j As Long
    Dim iEx As Object
    Dim iWbk As Object
    Dim iSht As Object
    Dim iWd As Document
    Dim iRow As Long, iCol As Long
    Set iEx = CreateObject("excel.Application")
    Set iWbk = iEx.workbooks.Add
    iPath = ActiveDocument.Path & "\"
    iName = Dir(iPath & "*.doc*")
    Do While iName <> ""
        If ActiveDocument.Name <> iName Then
            Set iSht = iWbk.worksheets.Add
            iSht.Name = iName
            Set iWd = Documents.Open(iPath & iName)
            iRow = iWd.Tables(1).Rows.Count
            iCol = iWd.Tables(1).Columns.Count
            For i = 1 To iRow
                For j = 1 To iCol
                    iSht.Cells(i, j) = Replace(Replace(iWd.Tables(1).Cell(i, j).Range.Text, Chr(7), ""), Chr(9), "")
                Next j
            Next i
            Set iSht = Nothing
            iWd.Close
            iName = Left(iName, InStr(1, iName, "."))
            iWbk.SaveAs iPath & iName & ".xlsx"
        End If
        iName = Dir
    Loop
    iWbk.Close
    Set iEx = Nothing
    
End Sub