使用 VBA 从 Word 中获取文本到 Excel
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18504387/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Getting text from Word to Excel using VBA
提问by user2723524
So far I have close to working code that parses the document and gets heading, title and text between two titles. The content I am trying to extract has bullets, line break, etc and I would like to maintain the format when I paste it into a cell. Have been looking around and reading a lot of forums but unable to figure out how to keep the formatting intact. I looked into PasteSpecial but that pastes the content across multiple cells plus I would like to avoid copy/paste if possible.
到目前为止，我已经接近可以解析文档并获取两个标题之间的标题、标题和文本的工作代码。我试图提取的内容有项目符号、换行符等，当我将其粘贴到单元格中时，我想保持格式。一直环顾四周并阅读了很多论坛，但无法弄清楚如何保持格式不变。我查看了 PasteSpecial 但这会将内容粘贴到多个单元格中，而且我希望尽可能避免复制/粘贴。
Below's a very early code I have (has bugs that I am debugging/fixing):
下面是我的一个非常早期的代码（有我正在调试/修复的错误）：
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 'e.g., 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 ' e.g., 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
回答by Keith
You probably found a solution by now, but what I would do is open excel, start the macro recording, then select a cell, click on the icon to expand the cell entry field, then paste some formatted text. Then stop the macro and view the code. The key is the pasting into the cell field at the top. Grab the bit of code that you need for your word macro. Hope this helps.
您现在可能已经找到了解决方案，但我要做的是打开 excel，开始宏录制，然后选择一个单元格，单击图标以展开单元格输入字段，然后粘贴一些格式化文本。然后停止宏并查看代码。关键是粘贴到顶部的单元格字段中。获取您的 word 宏所需的代码。希望这可以帮助。
