使用格式化将单词表导入excel答案

【问题标题】：Importing word tables into excel with formatting使用格式化将单词表导入excel
【发布时间】：2015-07-20 15:29:50
【问题描述】：

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

【问题讨论】：

您的代码可以正常传输，但没有保留格式，对吗？
stackoverflow.com/q/12245525/1161309
我不太确定如何修改我的代码以适应链接中的示例。我只想要单词表的第一列。

标签： vba excel ms-word

【解决方案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

显然，您可以通过使用一些变量来稍微清理一下，但这是基本思想。

【讨论】：

感谢此代码。这工作得很好，但速度要慢得多，并且会带来很多我不想要的额外东西。我想要的只是前景色、背景色和粗体、下划线或删除线。我可以在复制和粘贴后清理它，但这无济于事，它需要 5 倍的时间。
然后把粘贴改成pastespecial，选择你需要的？
我已经试过了。至少，手动完成。真的没有多少选择。
你已经运行了一个宏，检查你想要的每一个东西的源，设置一个布尔值，然后在传输时应用它

【解决方案2】：

试试这个（以一种蓝色为例，但最好的办法是在 Word 中检查哪个是蓝色、红色...）：

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

它对我有用。

【讨论】：