我需要將帶有大量表格的Word文檔導入到Excel工作表中。這很容易,但需要注意的是在輸入excel時保留word doc的格式。例如,字中的一些字段是藍色,一些是紅色。一些是藍色的下劃線,一些是紅色的下劃線。基本上,單詞doc中的任何顏色都需要在Excel表單中匹配。這是我進行實際導入的代碼。通過格式化將Word表格導入excel
Sub ImportWordTables_1()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Long 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Long 'column index in Excel
Dim tblCount As Long
wdFileName = Application.GetOpenFilename("Word files,*.doc;*.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
If TableNo = 0 Then
MsgBox "This document contains no tables", vbExclamation, "Import Word Table"
End If
tblStart = InputBox("Enter table number to start with", "Table Start")
iCol = 1
For tblCount = tblStart To .tables.Count
With .tables(tblCount)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
'find the last empty row in the current worksheet
nextRow = ThisWorkbook.ActiveSheet.Range("a" _
& Rows.Count).End(xlUp).Row + 1
'Just 1 column for now
'For iCol = 1 To .Columns.Count
ThisWorkbook.ActiveSheet.Cells(nextRow, iCol) = WorksheetFunction _
.Clean(.cell(iRow, iCol).Range.Text)
'ThisWorkbook.ActiveSheet.Cells(nextRow, iCol) = _
.cell(iRow, iCol).Range.Text
'Next iCol
Next iRow
End With
Next
End With
Set wdDoc = Nothing
End Sub
您的代碼正在傳輸正常,但它不保留格式,是否正確? – Raystafarian
http://stackoverflow.com/q/12245525/1161309 – Raystafarian
我不確定如何修改我的代碼以適合鏈接中的示例。我只想要單詞表中的第一列。 –