VBA Excel复制Word表格中的内容

时间:2015-05-22 22:29:00

标签: excel vba excel-vba

我有一个包含表的Word文件,我将浏览Word文件中的表并将它们放入Excel文件中

Example Word File:
-----------------------------------
|Col Header 1  | Col Header 2     |
-----------------------------------
|Content 1     | Content 2 line 1 |
|              | line 2           |
----------------------------------

当我尝试粘贴该内容或将其转移到excel时,它会删除新行并将内容混合在一起,或者如果我使用paste special,则将第1行和第2行放入新行。

此代码将内容放在一起:

Cells(x, y) = WorksheetFunction.Clean(wdDoc.tables(1).cell(6, 1).Range.Text)

Result in excel:
----------------------------------------
|Col Header 1  | Col Header 2          |
---------------------------------------
|Content 1     | Content 2 line 1line2 |
----------------------------------------

此代码将内容放在多行

wdDoc.tables(1).cell(6, 1).Range.Copy    
Sheet1.Cells(x, y).Select
Sheet1.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False

Result in excel:
----------------------------------------
|Col Header 1  | Col Header 2          |
---------------------------------------
|Content 1     | Content 2 line 1      |
----------------------------------------
|              | line2                 |
----------------------------------------

我只关心新行,不一定关心格式化。我会接受格式化,如果这是唯一的选择,但我似乎无法找到一种方法来让它甚至正确地传输内容。我已经尝试将其复制为公式,不同的特殊类型,没有运气。

非常感谢帮助

1 个答案:

答案 0 :(得分:2)

尝试使用换行符替换所有回车符。 Excel可以处理换行符,但正如您所见,将把回车放在一个单独的单元格上。

Sub TextToExcel()
    Dim wdDoc As Document, wdTab As Table
    Dim ii As Integer, jj As Integer, kk As Integer
    Dim xlApp As Excel.Application

    Set wdTab = ActiveDocument.Tables(1)

    ReDim Data(1 To wdTab.Rows.Count, 1 To wdTab.Columns.Count)

    Set xlApp = GetObject(, "Excel.Application")
    With xlApp.ActiveSheet
        For ii = 1 To wdTab.Rows.Count
            For jj = 1 To wdTab.Columns.Count
                Data(ii, jj) = VBA.Replace(wdTab.Cell(ii, jj).Range.Text, vbCr, vbLf)
            Next jj
        Next ii

        'Place the data
        With .Range(.Cells(1, 1), .Cells(wdTab.Rows.Count, wdTab.Rows.Count))
            .Value = Data
            .WrapText = True
        End With
    End With

    Set xlApp = Nothing

End Sub

*请注意,我没有在单词文档中使用换行符对此进行测试。

相关问题