如何在保留格式的同時將表格從 Word 復制到 Excel

Question

我已經編碼 VBA 很多年了，但這一次真的讓人頭疼。

任務很簡單- 將表格中的數據從 Microsoft Word 復制到 Microsoft Excel。

挑戰：保持 Word 數據的格式，包括項目符號列表和多個段落。 更具體地說，我需要將 Word 表中一個單元格中的所有格式化文本包含在相應 Excel 表中的單個單元格中。

我已經嘗試過的解決方案，特別是我卡住的地方：

---

方法01：在Word中選擇整個表格，在Excel中選擇一個單元格，然后粘貼。

Sub Method01_CopyAndPaste()

ActiveDocument.Tables(1).Select
Documents(1).ActiveWindow.Selection.Copy
Cells(1, 1).Select
ActiveSheet.Paste

End Sub

方法 01 的問題：只要 Word 表中有多個段落，Excel 就會創建多行並合並單元格。

---

方法 02：循環遍歷 Word 表，並將所有內容分配給一個數組（變體）。 然后遍歷 Excel 表並將數組中的值分配到表中。

Sub Method02_Array()

Dim r As Integer
Dim c As Integer
Dim AryTblData(1 To 10, 1 To 10) As Variant

'Loop through the 10x10 Source table and assign all values to 2 dimensional array
For r = 1 To 10
    For c = 1 To 10
        AryTblData(r, c) = ActiveDocument.Tables(1).Cell(r + 1, c)
    Next c
Next r

'Paste the array values into the activesheet starting at cell(1,1)
For r = 1 To 10
    For c = 1 To 10
        Cells(r, c) = WorksheetFunction.Clean(AryTblData(r, c))
    Next c
Next r

End Sub

方法 02 的問題：不保留格式。 具體來說，項目符號不會出現在 Excel 表格中。

---

方法03：使用Application.Sendkeys模擬手動跳轉到Word表格的一個單元格，復制，跳轉到Excel表格對應的單元格，粘貼，按{TAB}鍵跳轉到下一個單元格的過程，然后對表中的單元格總數重復此過程。

Sub Method03_Sendkeys()

Dim r As Integer
Dim c As Integer

'Loop through the 3x3 Source table and simulate sending keys to copy and paste, cell by cell
For r = 1 To 3
    For c = 1 To 3

        'Activate Microsoft Word window
        AppActivate ("word"), True

        'Select the appropriate cell in the Word table (based on the For Loop)
        ActiveDocument.Tables(1).Cell(r, c).Select

        'In Word, copy the selection
        Application.SendKeys "^c", True

        'Activate Microsoft Excel window
            'Note: I'm not sure why AppActivate ("excel") does not work, but
            'for some reason Application.caption works for me.
        AppActivate Application.Caption, True

        'Select the appropriate cell in the active Excel worksheet (based on the For Loop)
        Cells(r, c).Select

        'In Excel, edit cell contents
        Application.SendKeys "{F2}", True

        'In Excel, Paste
        Application.SendKeys "^v", True

        'In Excel, Save changes to cell and move 1 cell to the right
        Application.SendKeys "{TAB}", True

    Next c
Next r

End Sub

方法 03 的問題：它僅適用於 1 個單元格，但是一旦我嘗試復制和粘貼多個單元格，結果就會在多個單元格中一遍又一遍地重復相同的數據。

---

問題：這個任務甚至可以在 VBA 中實現嗎？ 我很想找到一個簡單而優雅的解決方案，但在這一點上，我會滿足於一些可行的方法。

非常感謝你的幫助！

Answer 1

根據我的評論，以下可能有效。 我無法測試，因為我沒有你的源數據

Sub Method02_Array()

Dim r As Integer
Dim c As Intege

For r = 1 To 10
    For c = 1 To 10
        ActiveDocument.Tables(1).Cell(r + 1, c).Range.Copy
        ActiveWorkbook.Sheets(1).Cells(r, c).Range.PasteSpecial operation:=xlPasteSpecialOperationNone, Paste:=xlPasteAll
    Next c
Next r

End Sub

Answer 2

要將 Word 或 pdf 中的多行粘貼到 Excel 中的單個單元格中 - 單擊單元格，按 F2，然后粘貼文本。 這將所有內容都保存在一個單元格中。 但是它不保留格式，包括顏色和刪除線