使用格式

Question

我需要将包含大量表格的word文档导入excel工作表。这很容易，但需要注意的是，在将word输入excel时保持单词doc的格式。例如，单词中的某些字段是蓝色，有些是红色。有些是蓝色的下划线，有些是红色的下划线。基本上，单词doc中的任何颜色都需要在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

尝试替换此行 -

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

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

Answer 2

尝试这个（一个蓝色的例子，但你能做的最好的事情就是检查哪个是你的蓝色，红色......在Word中）：

 If .Cell(iRow, iCol).Shading.BackgroundPatternColor = RGB(85, 60, 232) Then
                 Cells(nextrow, iCol).Interior.Color = RGB(85, 60, 232)

它对我有用。