繁体   English   中英

使用VBA从Word将文本获取到Excel

[英]Getting text from Word to Excel using VBA

到目前为止,我已经接近解析文档并在两个标题之间获取标题,标题和文本的工作代码。 我尝试提取的内容有项目符号,换行符等,当我将其粘贴到单元格中时,我想保持其格式。 一直到处逛逛并阅读了很多论坛,但无法弄清楚如何保持格式完整。 我调查了PasteSpecial,但是将内容粘贴到了多个单元格中,此外,如果可能的话,我希望避免复制/粘贴。

以下是我拥有的非常早的代码(有一些正在调试/修复的错误):

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

链接到样本文档

您现在可能已经找到了解决方案,但是我要做的是打开excel,开始宏录制,然后选择一个单元格,单击图标以展开单元格输入字段,然后粘贴一些格式化的文本。 然后停止宏并查看代码。 关键是粘贴到顶部的单元格字段中。 获取您的word宏所需的代码。 希望这可以帮助。

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM