Sub GetWordTable()    Dim WdApp As Object    Dim objTable As Object    Dim objDoc As Object    Dim strPath As String    Dim shtEach As Worksheet    Dim shtSelect As Worksheet    Dim i As Long    Dim j As Long    Dim x As Long    Dim y As Long    Dim k As Long    Dim brr As Variant    Set WdApp = CreateObject("Word.Application")    With Application.FileDialog(msoFileDialogFilePicker)        .Filters.Add "Word文件", "*.doc*", 1        '只顯示word文件        .AllowMultiSelect = False        '禁止多選文件        If .Show Then strPath = .SelectedItems(1) Else Exit Sub    End With    Application.ScreenUpdating = False    Application.DisplayAlerts = False    Set shtSelect = ActiveSheet    '當(dāng)前表賦值變量shtSelect，方便代碼運(yùn)行完成后葉落歸根回到開(kāi)始的地方    For Each shtEach In Worksheets    '刪除當(dāng)前工作表以外的所有工作表        If shtEach.Name <> shtSelect.Name Then shtEach.Delete    Next    shtSelect.Name = "EH看見(jiàn)星光"    '這句代碼不是無(wú)聊，作用在于……你猜……    '……其實(shí)是避免下面的程序工作表名稱重復(fù)    Set objDoc = WdApp.documents.Open(strPath)    '后臺(tái)打開(kāi)用戶選定的word文檔    For Each objTable In objDoc.tables    '遍歷文檔中的每個(gè)表格        k = k + 1        Worksheets.Add after:=Worksheets(Worksheets.Count)        '新建工作表        ActiveSheet.Name = k & "表"        x = objTable.Rows.Count        'table的行數(shù)        y = objTable.Columns.Count        'table的列數(shù)        ReDim brr(1 To x, 1 To y)        '以下遍歷行列，數(shù)據(jù)寫(xiě)入數(shù)組brr        For i = 1 To x            For j = 1 To y                brr(i, j) = "'" & Application.Clean(objTable.cell(i, j).Range.Text)                'Clean函數(shù)清除制表符等                '半角單引號(hào)將數(shù)據(jù)統(tǒng)一轉(zhuǎn)換為文本格式，避免身份證等數(shù)值變形            Next        Next        With [a1].Resize(x, y)            .Value = brr            '數(shù)據(jù)寫(xiě)入Excel工作表            .Borders.LineStyle = 1            '添加邊框線        End With    Next    shtSelect.Select    objDoc.Close: WdApp.Quit    Application.ScreenUpdating = True    Application.DisplayAlerts = True    Set objDoc = Nothing    Set WdApp = Nothing    MsgBox "共獲?。? & k & "張表格的數(shù)據(jù)。"End Sub