Word VBA 解決復制粘貼到 excel 時的換行或段落標記問題

Question

我已經設法使用 VBA 將 Word 中的表格復制並粘貼到 excel 中，但最終結果與我的預期不太一樣。

我想解決的一些單元格中存在換行問題。

例如，

我在 word 表格中有一個帶有某些換行符的文本，例如

“這是一個陽光明媚的日子，我們有以下選擇：”

   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

問候，
最大限度