比如說，有一個Word文件，里面有十幾張表格word中的表格如何轉為excel，現在急需將每個表格的數據復制到Excel，每個表格自成一份Sheetword中的表格如何轉為excel，關鍵是很不巧，你的秘書MISS李請假一個月回老家了……
操作動畫如下：
代碼如下
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
??? '當前表賦值變量shtSelect，方便代碼運行完成后葉落歸根回到開始的地方
??? For Each shtEach In Worksheets
??? '刪除當前工作表以外的所有工作表
??????? If shtEach.Name <> shtSelect.Name Then shtEach.Delete
??? Next
??? shtSelect.Name = "EH看見星光"
??? '這句代碼不是無聊，作用在于……你猜……
??? '……其實是避免下面的程序工作表名稱重復
??? Set objDoc = WdApp.documents.Open(strPath)
??? '后臺打開用戶選定的word文檔
??? For Each objTable In objDoc.tables
??? '遍歷文檔中的每個表格
??????? k = k + 1
??????? Worksheets.Add after:=Worksheets(Worksheets.Count)
??????? '新建工作表
??????? ActiveSheet.Name = k & "表"
??????? x = objTable.Rows.Count
??????? 'table的行數
??????? y = objTable.Columns.Count
??????? 'table的列數
??????? ReDim brr(1 To x, 1 To y)
??????? '以下遍歷行列，數據寫入數組brr
??????? For i = 1 To x
??????????? For j = 1 To y
??????????????? brr(i, j) = "'" & Application.Clean(objTable.cell(i, j).Range.Text)
??????????????? 'Clean函數清除制表符等
??????????????? '半角單引號將數據統一轉換為文本格式，避免身份證等數值變形
??????????? Next
??????? Next
??????? With [a1].Resize(x, y)
??????????? .Value = brr
??????????? '數據寫入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 & "張表格的數據。"
End Sub
代碼已有注釋說明，這里就不再啰嗦了。
揮手 祝安~