使用VBA从Word到Excel文本

到目前为止，我已经接近parsing文档的工作代码，并在两个标题之间获取标题，标题和文本。 我试图提取的内容有子弹，换行符等，我想保持格式，当我把它粘贴到一个单元格。 一直在环顾四周，阅读了很多论坛，但无法弄清楚如何保持格式不变。 我看着PasteSpecial，但粘贴多个单元格的内容，我想避免复制/粘贴，如果可能的话。

下面是我有一个很早的代码（有错误，我正在debugging/修复）：

Sub GetTextFromWord() Dim Paragraph As Object, WordApp As Object, WordDoc As Object Dim para As Object Dim paraText As String Dim outlineLevel As Integer Dim title As String Dim body As String Dim myRange As Object Dim documentText As String Dim startPos As Long Dim stopPos As Long Dim file As String Dim i As Long Dim category As String startPos = -1 i = 2 Application.ScreenUpdating = True Application.DisplayAlerts = False file = "C:\Sample.doc" Set WordApp = CreateObject("Word.Application") WordApp.Visible = True Set WordDoc = WordApp.Documents.Open(file) Set myRange = WordDoc.Range documentText = myRange.Text For Each para In ActiveDocument.Paragraphs ' Get the current outline level. outlineLevel = para.outlineLevel ' Cateogry/Header begins outline level 1, and ends at the next outline level 1. If outlineLevel = wdOutlineLevel1 Then 'eg, 1 Header category = para.Range.Text End If ' Set category as value for cells in Column A Application.ActiveWorkbook.Worksheets("Sheet1").Cells(i - 1, 1).Value = category ' Title begins outline level 1, and ends at the next outline level 1. If outlineLevel = wdOutlineLevel2 Then ' eg, 1.1 ' Get the title and update cells in Column B title = para.Range.Text Application.ActiveWorkbook.Worksheets("Sheet1").Cells(i, 2).Value = title startPos = InStr(nextPosition, documentText, title, vbTextCompare) If startPos <> stopPos Then ' this is text between the two titles body = Mid$(documentText, startPos, stopPos) ActiveSheet.Cells(i - 1, 3).Value = body End If stopPos = startPos i = i + 1 End If Next para WordDoc.Close WordApp.Quit Set WordDoc = Nothing Set WordApp = Nothing End Sub 

链接到样本文档

Answer 1

您现在可能已经find了一个解决scheme，但是我要做的是打开excel，启动macroslogging，然后select一个单元格，单击图标展开单元格input字段，然后粘贴一些格式化的文本。 然后停止macros并查看代码。 关键是粘贴到顶部的单元格区域。 抓住你的单词macros所需的一点代码。 希望这可以帮助。