VBA Excel从Word表复制内容

David 发表于 Dev

大卫

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

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

当我尝试粘贴该内容或将其传输到Excel时，它要么删除新行并将内容混在一起，要么如果我使用特殊粘贴，则将第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                 |
----------------------------------------

我只关心新行，不必关心格式。如果那是唯一的选择，我会接受格式设置，但是我似乎找不到一种方法来使它正确地传输内容。我试过将其复制为公式，并且没有运气，使用了不同的粘贴特殊类型。

非常感谢您的帮助

CuberChase

尝试用换行符替换所有回车符。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

*请注意，我尚未在word文档中使用换行符对此进行过测试。

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。