通过格式化将单词表导入excel

我需要将大量表格的Word文档导入到Excel工作表中。 这很容易，但是需要注意的是，在inputexcel时，要保留word doc的格式。 例如，字中的一些字段是蓝色，一些是红色的。 一些是蓝色的下划线，一些是红色的下划线。 基本上，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 

Answer 1

尝试replace这一行 –

 ThisWorkbook.ActiveSheet.Cells(nextRow, iCol) = WorksheetFunction _ .Clean(.cell(iRow, iCol).Range.Text) 

用这个代替 –

 .cell(iRow, iCol).Range.Copy ThisWorkbook.ActiveSheet.Cells(nextrow, iCol).Activate ThisWorkbook.ActiveSheet.Paste 

显然你可以通过使用一些variables来清理这个，但这是基本的想法。