Question

我正在使用Powerpoint幻灯片，其中列出的文本很少。我必须在包含大量标题和文本的Word文档中搜索这些文本。找到标题文本后，我需要复制标题下的文本并粘贴到新文档中。

基本上，VBA编码必须在Powerpoint VBA中完成，后台有两个文档用于搜索文本并将文本粘贴到另一个文档中。

我打开了doc这个词。但是搜索其中的文本并选择它来复制到另一个文档是我无法做到的。请帮助我。

Answer 1

我明白了。以下不是很优雅，因为它使用了我一直试图避免的选择，但这是我知道实现这一目标的唯一方法。

免责声明1：这是在Word VBA中制作的，因此您需要稍加调整，例如设置对Word的引用，使用wrdApp = New Word.Application对象并声明doc和{{ 1}}显式为newdoc。

免责声明2：由于您搜索文本而不是相应的标题，请注意这将找到该文本的第一个出现，因此您最好不要在几个章节中使用相同的文本。 ; - ）

免责声明3：我不能再贴了！ :-(我的剪贴板已设置，它贴在别处，但我不能粘贴在这里。首先编辑代码，希望在一分钟内......

编辑：yepp，再次粘贴作品。： - ）

Word.Document

编辑：如果您需要搜索第1列中某些表中的“功能”，并在第2列中提供说明，并且您需要在新文档中使用该说明，请尝试以下操作：

Sub FindChapter()

Dim doc As Document, newdoc As Document
Dim startrange As Long, endrange As Long
Dim HeadingToFind As String, ChapterToFind As String

ChapterToFind = "zgasfdiukzfdggsdaf" 'just for testing

Set doc = ActiveDocument
Set newdoc = Documents.Add
doc.Activate
Selection.HomeKey unit:=wdStory

With Selection
    With .Find
        .ClearFormatting
        .Text = ChapterToFind
        .MatchWildcards = False
        .MatchCase = True
        .Execute
    End With

    If .Find.Found Then
    '**********
    'Find preceding heading to know where chapter starts
    '**********
        .Collapse wdCollapseStart
        With .Find
            .Text = ""
            .Style = "Heading 1"
            .Forward = False
            .Execute
            If Not .Found Then
                MsgBox "Could not find chapter heading"
                Exit Sub
            End If
        End With

        .MoveDown Count:=1
        .HomeKey unit:=wdLine
        startrange = .Start

        '*********
        'Find next heading to know where chapter ends
        '*********
        .Find.Forward = True
        .Find.Execute
        .Collapse wdCollapseStart
        .MoveUp Count:=1
        .EndKey unit:=wdLine
        endrange = .End

        doc.Range(startrange, endrange).Copy
        newdoc.Content.Paste
        newdoc.SaveAs2 doc.Path & "\" & HeadingToFind & ".docx", wdFormatFlatXML
    Else
        MsgBox "Chapter not found"
    End If

End With


End Sub

编辑：轻微改编，因此您可以粘贴而不覆盖newdoc中的现有内容：而不是Sub FindFeature() Dim doc As Document, newdoc As Document Dim FeatureToFind As String Dim ro As Long, tbl As Table FeatureToFind = "zgasfdiukzfdggsdaf" 'just for testing Set doc = ActiveDocument Set newdoc = Documents.Add doc.Activate Selection.HomeKey unit:=wdStory With Selection With .Find .ClearFormatting .Text = FeatureToFind .MatchWildcards = False .MatchCase = True .Execute End With If .Find.Found Then Set tbl = Selection.Tables(1) ro = Selection.Cells(1).RowIndex tbl.Cell(ro, 2).Range.Copy newdoc.Range.Paste End If End With End Sub只是使用沿着这条线的东西：

newdoc.Range.Paste

使用VBA和Powerpoint在Word文档中搜索标题并将文本复制到另一个Word文档中

1 个答案: