如何通过代码将关键字所在的段落提取到新文档中？

tangqingfu

请教如何通过代码将关键字所在的句子提取到新文档中（关键字为Arial字体中的关键字）？最好能实现这样的功能：在运行代码后，出现一个对话框，在输入框直接输入所需要查找的文本（或通过复制方式将文本复制到输入框中）；或者将复制剪切板的内容到输入框；无对话框样式亦可
附件文档中的音标即为Arial字体，即将指定音标所在的段落复制到新文档中

daibao88

本论坛有相似的代码，自己搜吧。大体思路是，查找，找到后扩展到整段文本，复制，新建、粘贴

zhanglei1371

问题过于简单，严重缺乏挑战性！难度增加三倍，就有代码了:)^-^

tangqingfu

daibao88 发表于 2019-5-11 21:48
本论坛有相似的代码，自己搜吧。大体思路是，查找，找到后扩展到整段文本，复制，新建、粘贴

谢谢daibao88兄，有搜索过，可惜不会变通。
有些音标字体（如ɔɪ）在复制到输入框时，会变成?？，无法有效搜索，烦请兄台帮忙

tangqingfu

zhanglei1371 发表于 2019-5-11 22:57
问题过于简单，严重缺乏挑战性！难度增加三倍，就有代码了:)^-^

谢谢张兄，有搜索过，可惜不会变通。
有些音标字体（boy中的oy对应的音标）在复制到输入框时，会变成?？，无法有效搜索，烦请张兄帮忙
也请张兄移步帮我看一下这个帖子的问题：
http://club.excelhome.net/thread-1476286-1-1.html

daibao88

变通一下，直接读取剪切板文本，按此查找

tangqingfu

daibao88 发表于 2019-5-12 10:59
变通一下，直接读取剪切板文本，按此查找

谢谢，用代码怎么编写，能否请daibao88兄指教？

daibao88

Sub 查找指定段落()
    Dim myrange As range, x As Boolean, wdn As Document, wd As Document, str As String
    x = False
    Set wd = ActiveDocument
    Set myrange = wd.range
    Dim DataObj As New MSForms.DataObject
    DataObj.GetFromClipboard
    If DataObj.GetFormat(1) = True Then str = DataObj.GetText(1)
    Do While x = False
        With myrange.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = str
            .Execute
            If .Found Then
                myrange.Expand Unit:=wdParagraph
                myrange.Copy
                If wdn Is Nothing Then Set wdn = Application.Documents.Add
                wdn.range(wdn.range.End - 1, wdn.range.End - 1).Paste
                myrange.SetRange myrange.End, wd.range.End - 1
            Else
                x = True
            End If
        End With
    Loop
End Sub
参考吧，我也不太会

tangqingfu

daibao88 发表于 2019-5-12 13:56
Sub 查找指定段落()
    Dim myrange As range, x As Boolean, wdn As Document, wd As Document, str As  ...

谢谢daibao88兄，在Word 2003中测试代码，提示错误，请教该如何解决？

daibao88

引用 了Microsoft Forms 2.0 Objiect Librery 吗？先引用试试