excel - Word VBA 解决复制粘贴到 Excel 时的换行或段落标记问题

Question

我已经设法使用 VBA 将 word 中的表格复制并粘贴到 excel 中，但最终结果与我的预期不太一样。

我想解决的一些单元格中存在换行问题。

例如，

我在单词表中有一个带有某些换行符的文本，例如

“这是一个阳光明媚的日子，我们有以下选择:”

   a) Go shopping

   b) Stay Indoor

这样做的问题是，一旦它被导入到 excel 中，点 a 和 b 就不再在 excel 的同一个单元格中。 Excel 将其作为一个新单元格插入，而不是将这些点格式化为一个单元格。

我尝试使用查找和替换将换行符 ^p 替换为空白，但字母 a 和 b 将作为空格删除。我不想将我的 a 和 b 替换为空格。我仍然需要将它们插入到 Excel 单元格中。

Sub CreateExcel()

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim tableWord As Word.Table


Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False

Set xlWB = xlApp.Workbooks.Add ' create a new workbook
'declare the cell to put the text in
With xlWB.Worksheets(1)
     Set tableWord = ActiveDocument.Tables(1)
     tableWord.Range.Copy
    .Paste Destination:=xlWB.Worksheets(1).Range("A1")

    xlApp.Dialogs(xlDialogSaveAs).Show
End With

xlWB.Close False ' close the workbook without saving
xlApp.Quit ' close the Excel application
Set xlWB = Nothing
Set xlApp = Nothing

End Sub

Answer 1

您可以尝试使用 进行搜索和替换回车 字符:Chr(10)
[编辑]
好吧，我找不到直接处理您的问题的方法，也许更好的 vba 专家可能会找到解决方案。

我发现的解决方法是在粘贴单元格的值后连接它们，因为没有其他方法可以保持格式(我调整了我的 Excel 代码以使其在 Word vba 中可用):

Option Explicit

Sub CreateExcel()

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim tableWord As Word.Table
Dim cell As Excel.Range, rUsed As Excel.Range, target As Excel.Range
Dim val As String

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
'xlApp.Visible = False

Set xlWB = xlApp.Workbooks.Add ' create a new workbook
'declare the cell to put the text in
With xlWB.Worksheets(1)
     Set tableWord = ActiveDocument.Tables(1)
     tableWord.Range.Copy
    .Paste Destination:=xlWB.Worksheets(1).Range("A1")

    'Select used range to get every cell that was pasted and has content
    Set rUsed = xlWB.Worksheets(1).UsedRange
    Set target = rUsed.Cells(1, 1)
    'Get the value of each cell and concatenate its value
    For Each cell In rUsed
        If cell.Value <> "" Then
            val = val + cell.Value + Chr(10)
            cell.ClearContents
        End If
    Next cell
    'Remove last carriage return
    target.Value = Left(val, Len(val) - 1)

    xlApp.Dialogs(xlDialogSaveAs).Show
End With

xlWB.Close False ' close the workbook without saving
xlApp.Quit ' close the Excel application
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

问候，
最大限度