VBA Excel中复制内容从Word表格

Question

我有一个包含一个表，我会通过Word文件中的表和将它们放入一个Excel文件的Word文件

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

当我尝试粘贴内容或转移它擅长它要么删除新行并将内容混合在一起，要么如果我使用特殊粘贴，它会将第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     | 
---------------------------------------- 

我只在乎新线的内容，不一定在乎的格式。我会接受格式化，如果这是唯一的选择，但我似乎无法找到一种方法让它甚至正确地传输内容。我试图将其作为公式复制，不同的pastespecial类型没有运气。

非常感谢帮助

Answer 1

尝试用换行符替换所有回车符。 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文档中用换行符测试过这个。