请教如何批量将加粗的单词、词组所在段落的文本提取到新文档中？

tangqingfu

请教如何通过代码，批量将加粗的单词、词组所在段落的文本（即所有加粗单词、词组及其音标、词义）按顺序提取到新新文档中？

413191246se

* 唐兄：过年好！

tangqingfu

413191246se 发表于 2021-2-17 03:40
* 唐兄：过年好！

新年好，413191246se兄！
感谢413191246se兄的一再帮助，代码可以实现批量提取，但会将不含音标、词组的加粗单词、词组所在段落的文本一起提取出来，如果能去除这些内容就更理想了。

413191246se

* 唐兄：请再试！

1. Sub aaaa_Get_Bold_Text_Test_Opt()
   
2.     Documents.Add ActiveDocument.FullName
   
3.     Dim i As Paragraph
   
4.     For Each i In ActiveDocument.Paragraphs
   
5.         If i.Range.Words(1).Bold = False Then i.Range.Delete
   
6.         If Not i.Range Like "*/*" Then i.Range.Delete
   
7.     Next
   
8.     MsgBox "Doc not save!", 0 + 16
   
9. End Sub

复制代码

蓝桥玄霜

想要这样的吗？

相见是缘8

蓝桥玄霜 发表于 2021-2-17 11:16
想要这样的吗？

Sub lqxs()
    Dim doc, w, c, s$, Arr(1 To 1000), n%
        Set doc = ActiveDocument
            With doc
                  For Each c In .Content.Paragraphs
                  s = ""
                  For Each w In c.Range.Words
                  If w.Bold = True Then
                  s = s & w.Text
              End If
           Next
           If s <> "" Then n = n + 1: Arr(n) = s
        Next
    End With
    '版主！请再指教怎么写入新文档！
End Sub